First cut at disk image generation; generated disk will not currently boot
This commit is contained in:
parent
264ce5d269
commit
c508456325
BIN
ProDOS_2_4_2.dsk
Normal file
BIN
ProDOS_2_4_2.dsk
Normal file
Binary file not shown.
|
@ -7,10 +7,10 @@
|
||||||
(let [ops
|
(let [ops
|
||||||
{:php 0x08 :plp 0x28 :pha 0x48 :pla 0x68 :dey 0x88 :tay 0xa8 :iny 0xc8 :inx 0xe8
|
{:php 0x08 :plp 0x28 :pha 0x48 :pla 0x68 :dey 0x88 :tay 0xa8 :iny 0xc8 :inx 0xe8
|
||||||
:clc 0x18 :sec 0x38 :cli 0x58 :sei 0x78 :tya 0x98 :clv 0xb8 :cld 0xd8 :sed 0xf8
|
:clc 0x18 :sec 0x38 :cli 0x58 :sei 0x78 :tya 0x98 :clv 0xb8 :cld 0xd8 :sed 0xf8
|
||||||
:txa 0x8a :txs 0x9a :tax 0xaa :tsx 0xba :dex 0xca :nop 0xea :brk 0x00 :rti 0x40
|
:txa 0x8a :txs 0x9a :tax 0xaa :tsx 0xba :dex 0xca :nop 0xea :rti 0x40 :rts 0x60}]
|
||||||
:rts 0x60}]
|
|
||||||
(each [opcode byte (pairs ops)]
|
(each [opcode byte (pairs ops)]
|
||||||
(tset opcodes opcode (fn [mode] (if mode nil byte)))))
|
(tset opcodes opcode (fn [mode] (if mode nil byte)))))
|
||||||
|
(set opcodes.brk (fn [mode] (if (or (= mode :imm) (= mode nil)) 0x00 nil)))
|
||||||
|
|
||||||
; branch ops
|
; branch ops
|
||||||
(let [ops {:bpl 0x10 :bmi 0x30 :bvc 0x50 :bvs 0x70 :bcc 0x90 :bcs 0xb0 :bne 0xd0 :beq 0xf0}]
|
(let [ops {:bpl 0x10 :bmi 0x30 :bvc 0x50 :bvs 0x70 :bcc 0x90 :bcs 0xb0 :bne 0xd0 :beq 0xf0}]
|
||||||
|
|
336
asm/prodos.fnl
Normal file
336
asm/prodos.fnl
Normal file
|
@ -0,0 +1,336 @@
|
||||||
|
(local Object (require :core.object))
|
||||||
|
(local Prodos (Object:extend))
|
||||||
|
(local {: bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
|
||||||
|
: int8-to-bytes : int16-to-bytes : int24-to-bytes
|
||||||
|
: splice : lo : hi} (require :lib.util))
|
||||||
|
|
||||||
|
(local prodos-mli :0xbf00)
|
||||||
|
(fn Prodos.install-words [vm]
|
||||||
|
(fn prodos-call [cmd param-addr crash-on-fail]
|
||||||
|
[:block
|
||||||
|
[:jsr prodos-mli]
|
||||||
|
[:db cmd]
|
||||||
|
[:ref param-addr]
|
||||||
|
(when crash-on-fail
|
||||||
|
[:block
|
||||||
|
[:beq :success]
|
||||||
|
[:brk 0]
|
||||||
|
:success])])
|
||||||
|
(vm.code:append :currently-open-file [:db 0])
|
||||||
|
(vm:def :open ; filename buffer --
|
||||||
|
[:block
|
||||||
|
[:lda vm.ST1 :x] [:sta :open-param-filename]
|
||||||
|
[:lda vm.ST1H :x] [:sta :open-param-filename-hi]
|
||||||
|
[:lda vm.TOP :x] [:sta :open-param-buffer]
|
||||||
|
[:lda vm.TOPH :x] [:sta :open-param-buffer-hi]
|
||||||
|
(prodos-call 0xc8 :open-params true)
|
||||||
|
[:lda :open-param-refnum]
|
||||||
|
[:sta :currently-open-file]
|
||||||
|
(vm:drop) (vm:drop)])
|
||||||
|
(vm.code:append
|
||||||
|
:open-params [:db 3]
|
||||||
|
:open-param-filename [:db 0]
|
||||||
|
:open-param-filename-hi [:db 0]
|
||||||
|
:open-param-buffer [:db 0]
|
||||||
|
:open-param-buffer-hi [:db 0]
|
||||||
|
:open-param-refnum [:db 0])
|
||||||
|
|
||||||
|
(vm:def
|
||||||
|
[:block
|
||||||
|
:flush [:export :flush] ; --
|
||||||
|
[:lda 0xcd]
|
||||||
|
[:bne :prodos-flush-close]
|
||||||
|
:close [:export :close] ; --
|
||||||
|
[:lda 0xcc]
|
||||||
|
:prodos-flush-close
|
||||||
|
[:sta :fc-cmd]
|
||||||
|
[:lda :currently-open-file]
|
||||||
|
[:sta :fc-param-refnum]
|
||||||
|
[:jsr prodos-mli]
|
||||||
|
:fc-cmd [:db 0] [:ref :fc-params]
|
||||||
|
[:beq :success]
|
||||||
|
[:brk 0]
|
||||||
|
:success])
|
||||||
|
(vm.code:append
|
||||||
|
:fc-params [:db 1]
|
||||||
|
:fc-param-refnum [:db 0])
|
||||||
|
|
||||||
|
(vm:def
|
||||||
|
[:block
|
||||||
|
:write [:export :write] ; count buffer -- count
|
||||||
|
[:lda 0xcb]
|
||||||
|
[:bne :prodos-read-write]
|
||||||
|
:read [:export :read] ; count buffer -- count
|
||||||
|
[:lda 0xca]
|
||||||
|
:prodos-read-write
|
||||||
|
[:sta :rw-cmd]
|
||||||
|
[:lda :currently-open-file]
|
||||||
|
[:sta :rw-param-refnum]
|
||||||
|
[:lda vm.TOP :x] [:sta :rw-param-buffer]
|
||||||
|
[:lda vm.TOPH :x] [:sta :rw-param-buffer-hi]
|
||||||
|
[:lda vm.ST1 :x] [:sta :rw-param-count]
|
||||||
|
[:lda vm.ST1H :x] [:sta :rw-param-count-hi]
|
||||||
|
[:jsr prodos-mli]
|
||||||
|
:rw-cmd [:db 0] [:ref :rw-params]
|
||||||
|
[:beq :success]
|
||||||
|
[:cmp 0x4c]
|
||||||
|
[:beq :success]
|
||||||
|
[:brk 0]
|
||||||
|
:success
|
||||||
|
[:lda :rw-param-count-out] [:sta vm.ST1 :x]
|
||||||
|
[:lda :rw-param-count-out-hi] [:sta vm.ST1H :x]
|
||||||
|
(vm:drop)])
|
||||||
|
(vm.code:append
|
||||||
|
:rw-params [:db 4]
|
||||||
|
:rw-param-refnum [:db 0]
|
||||||
|
:rw-param-buffer [:db 0]
|
||||||
|
:rw-param-buffer-hi [:db 0]
|
||||||
|
:rw-param-count [:db 0]
|
||||||
|
:rw-param-count-hi [:db 0]
|
||||||
|
:rw-param-count-out [:db 0]
|
||||||
|
:rw-param-count-out-hi [:db 0])
|
||||||
|
|
||||||
|
; this does not handle files bigger than 64kb; I don't want or need to implement 24-bit numbers
|
||||||
|
(vm:def :seek ; position --
|
||||||
|
[:lda :currently-open-file]
|
||||||
|
[:sta :seek-param-refnum]
|
||||||
|
[:lda vm.TOP :x] [:sta :seek-param-position]
|
||||||
|
[:lda vm.TOPH :x] [:sta :seek-param-position-hi]
|
||||||
|
(prodos-call 0xce :seek-params true)
|
||||||
|
(vm:drop))
|
||||||
|
(vm.code:append
|
||||||
|
:seek-params [:db 2]
|
||||||
|
:seek-param-refnum [:db 0]
|
||||||
|
:seek-param-position [:db 0]
|
||||||
|
:seek-param-position-hi [:dw 0]))
|
||||||
|
|
||||||
|
(fn Prodos.new [self filename]
|
||||||
|
(local f (io.open filename :r))
|
||||||
|
(set self.bytes (f:read "*a"))
|
||||||
|
(f:close)
|
||||||
|
(assert (= (length self.bytes) 143360))
|
||||||
|
(self:parse-structure))
|
||||||
|
|
||||||
|
(fn Prodos.write [self filename]
|
||||||
|
(local f (io.open filename :w))
|
||||||
|
(f:write self.bytes)
|
||||||
|
(f:close))
|
||||||
|
|
||||||
|
(fn Prodos.sector-offset [self itrack isector]
|
||||||
|
(+ (* itrack 0x1000) (* isector 0x100)))
|
||||||
|
(fn Prodos.sector [self itrack isector]
|
||||||
|
(local offset (self:sector-offset itrack isector))
|
||||||
|
(self.bytes:sub (+ offset 1) (+ offset 0x100)))
|
||||||
|
|
||||||
|
(fn Prodos.set-sector [self itrack isector bytes]
|
||||||
|
(assert (<= (length bytes) 256))
|
||||||
|
(set self.bytes (splice self.bytes (+ (* itrack 0x1000) (* isector 0x100)) bytes)))
|
||||||
|
|
||||||
|
(local prodos-to-dos [0 14 13 12 11 10 9 8 7 6 5 4 3 2 1 15])
|
||||||
|
(fn Prodos.block-sectors [self index]
|
||||||
|
(local track (math.floor (/ index 8)))
|
||||||
|
(local iprodos (* (% index 8) 2))
|
||||||
|
(local isector1 (. prodos-to-dos (+ 1 iprodos)))
|
||||||
|
(local isector2 (. prodos-to-dos (+ 2 iprodos)))
|
||||||
|
(values track isector1 isector2))
|
||||||
|
|
||||||
|
(fn Prodos.block [self index]
|
||||||
|
(local (track isector1 isector2) (self:block-sectors index))
|
||||||
|
(.. (self:sector track isector1) (self:sector track isector2)))
|
||||||
|
|
||||||
|
(fn Prodos.set-block [self index bytes]
|
||||||
|
(local (track isector1 isector2) (self:block-sectors index))
|
||||||
|
(self:set-sector track isector1 (bytes:sub 1 256))
|
||||||
|
(self:set-sector track isector2 (bytes:sub 257 512))
|
||||||
|
(local bitmap (self:parse-bitmap))
|
||||||
|
(when (. bitmap index)
|
||||||
|
(tset bitmap index nil)
|
||||||
|
(self:set-bitmap bitmap)))
|
||||||
|
|
||||||
|
(fn Prodos.parse-entry [self bytes]
|
||||||
|
(local type_namelen (bytes-to-uint8 bytes 0))
|
||||||
|
(local entry-type (bit.rshift (bit.band type_namelen 0xf0) 4))
|
||||||
|
(local namelen (bit.band type_namelen 0x0f))
|
||||||
|
(local name (bytes:sub 2 (+ 1 namelen)))
|
||||||
|
(if (= entry-type 0x0f)
|
||||||
|
{: entry-type : name
|
||||||
|
:version (bytes-to-uint8 bytes 0x1c)
|
||||||
|
:min-version (bytes-to-uint8 bytes 0x1d)
|
||||||
|
:access (bytes-to-uint8 bytes 0x1e)
|
||||||
|
:entry-length (bytes-to-uint8 bytes 0x1f)
|
||||||
|
:entries-per-block (bytes-to-uint8 bytes 0x20)
|
||||||
|
:file-count (bytes-to-uint16 bytes 0x21)
|
||||||
|
:bitmap-pointer (bytes-to-uint16 bytes 0x23)
|
||||||
|
:total-blocks (bytes-to-uint16 bytes 0x25)}
|
||||||
|
{: entry-type : name
|
||||||
|
:file-type (bytes-to-uint8 bytes 0x10)
|
||||||
|
:key-pointer (bytes-to-uint16 bytes 0x11)
|
||||||
|
:blocks-used (bytes-to-uint16 bytes 0x13)
|
||||||
|
:eof (bytes-to-uint24 bytes 0x15)
|
||||||
|
:version (bytes-to-uint8 bytes 0x1c)
|
||||||
|
:min-version (bytes-to-uint8 bytes 0x1d)
|
||||||
|
:access (bytes-to-uint8 bytes 0x1e)
|
||||||
|
:aux-type (bytes-to-uint16 bytes 0x1f)
|
||||||
|
:header-pointer (bytes-to-uint16 bytes 0x25)}))
|
||||||
|
|
||||||
|
(fn Prodos.parse-directory [self iblock]
|
||||||
|
(local bytes (self:block iblock))
|
||||||
|
(local prev-block (bytes-to-uint16 bytes 0x00))
|
||||||
|
(local next-block (bytes-to-uint16 bytes 0x02))
|
||||||
|
(local entries [])
|
||||||
|
(for [offset 0x04 0x1ff 0x27]
|
||||||
|
(when (>= (length bytes) (+ offset 0x27))
|
||||||
|
(local entry (self:parse-entry (bytes:sub (+ offset 1) (+ offset 0x27))))
|
||||||
|
(set entry.entry-offset offset)
|
||||||
|
(table.insert entries entry)))
|
||||||
|
{: prev-block : next-block : entries})
|
||||||
|
|
||||||
|
(set Prodos.storage-type {
|
||||||
|
:deleted 0
|
||||||
|
:seedling 1
|
||||||
|
:sapling 2
|
||||||
|
:tree 3
|
||||||
|
:dir 13
|
||||||
|
:subdir-header 14
|
||||||
|
:volume-header 15
|
||||||
|
})
|
||||||
|
|
||||||
|
(set Prodos.file-type {
|
||||||
|
:none 0x00
|
||||||
|
:BAD 0x01
|
||||||
|
:TXT 0x04
|
||||||
|
:BIN 0x06
|
||||||
|
:DIR 0x0F
|
||||||
|
:ADB 0x19
|
||||||
|
:AWP 0x1a
|
||||||
|
:ASP 0x1b
|
||||||
|
:PAS 0xef
|
||||||
|
:CMD 0xf0
|
||||||
|
:BAS 0xfc
|
||||||
|
:VAR 0xfd
|
||||||
|
:REL 0xfe
|
||||||
|
:SYS 0xff
|
||||||
|
})
|
||||||
|
|
||||||
|
(fn Prodos.parse-structure [self]
|
||||||
|
(set self.files {})
|
||||||
|
(set self.next-free nil)
|
||||||
|
(set self.root nil)
|
||||||
|
(var iblock 2)
|
||||||
|
(while (~= iblock 0)
|
||||||
|
(local dir (self:parse-directory iblock))
|
||||||
|
(each [ientry entry (ipairs dir.entries)]
|
||||||
|
(match entry.entry-type
|
||||||
|
self.storage-type.volume-header (set self.root entry)
|
||||||
|
self.storage-type.deleted (set self.next-free {: entry : iblock : ientry})
|
||||||
|
_ (tset self.files entry.name {: entry : iblock : ientry})))
|
||||||
|
(set iblock dir.next-block))
|
||||||
|
self)
|
||||||
|
|
||||||
|
(fn Prodos.parse-index [self iblock]
|
||||||
|
(local block (self:block iblock))
|
||||||
|
(local index [])
|
||||||
|
(for [i 1 256]
|
||||||
|
(local lo (block:sub i i))
|
||||||
|
(local hi (block:sub (+ i 256) (+ i 256)))
|
||||||
|
(table.insert index (bytes-to-uint16 (.. lo hi)))))
|
||||||
|
|
||||||
|
(fn Prodos.set-index [self iblock index]
|
||||||
|
(var block "")
|
||||||
|
(for [i 1 256] (set block (.. block (string.char (lo (or (. index i) 0))))))
|
||||||
|
(for [i 1 256] (set block (.. block (string.char (hi (or (. index i) 0))))))
|
||||||
|
(self:set-block iblock block))
|
||||||
|
|
||||||
|
(fn bit-in-bytes [bytes ibit]
|
||||||
|
(local ibyte (math.floor (/ ibit 8)))
|
||||||
|
(local byte (string.byte (bytes:sub (+ ibyte 1) (+ ibyte 1))))
|
||||||
|
(local mask (bit.lshift 1 (% ibit 8)))
|
||||||
|
(values byte mask ibyte))
|
||||||
|
|
||||||
|
(fn Prodos.parse-bitmap [self]
|
||||||
|
(local block (self:block self.root.bitmap-pointer))
|
||||||
|
(local bitmap {})
|
||||||
|
(for [ibit 0 280]
|
||||||
|
(local (byte mask) (bit-in-bytes block ibit))
|
||||||
|
(when (~= (bit.band byte mask) 0)
|
||||||
|
(tset bitmap ibit true)))
|
||||||
|
bitmap)
|
||||||
|
|
||||||
|
(fn Prodos.set-bitmap [self bitmap]
|
||||||
|
(var block (string.rep "\0" 512))
|
||||||
|
(each [ibit f (pairs bitmap)]
|
||||||
|
(when (= f true)
|
||||||
|
(local (byte mask ibyte) (bit-in-bytes block ibit))
|
||||||
|
(set block (splice block ibyte (string.char (bit.bor byte mask))))))
|
||||||
|
(self:set-block self.root.bitmap-pointer block))
|
||||||
|
|
||||||
|
(fn Prodos.find-next-free-block [self]
|
||||||
|
(next (self:parse-bitmap)))
|
||||||
|
|
||||||
|
(fn Prodos.add-file-data [self bytes]
|
||||||
|
(assert (< (length bytes) 0xffff))
|
||||||
|
(if (> (length bytes) 512)
|
||||||
|
(let [index []]
|
||||||
|
(for [offset 1 (length bytes) 512]
|
||||||
|
(local iblock (self:add-file-data (bytes:gsub offset (+ offset 511))))
|
||||||
|
(table.insert index iblock))
|
||||||
|
(local iblock-index (self:find-next-free-block))
|
||||||
|
(self:set-index iblock-index index)
|
||||||
|
(values iblock-index self.storage-type.sapling (+ (length index) 1)))
|
||||||
|
|
||||||
|
(let [iblock-index (self:find-next-free-block)]
|
||||||
|
(self:set-block iblock-index bytes)
|
||||||
|
(values iblock-index self.storage-type.seedling 1))))
|
||||||
|
|
||||||
|
(fn Prodos.generate-file-entry [self iblock-parent filename type aux bytes]
|
||||||
|
(local (iblock storage-type block-count) (self:add-file-data bytes))
|
||||||
|
(..
|
||||||
|
(int8-to-bytes (bit.bor (bit.lshift storage-type 4) (length filename)))
|
||||||
|
filename
|
||||||
|
(string.rep "\0" (- 15 (length filename)))
|
||||||
|
(int8-to-bytes type)
|
||||||
|
(int16-to-bytes iblock)
|
||||||
|
(int16-to-bytes block-count)
|
||||||
|
(int24-to-bytes (length bytes))
|
||||||
|
"\0\0\0\0" ; created date
|
||||||
|
(int8-to-bytes 36) ; version
|
||||||
|
(int8-to-bytes 0) ; min-version
|
||||||
|
(int8-to-bytes 0x01) ; access (read-only, locked)
|
||||||
|
(int16-to-bytes aux) ; aux-type - generally load address
|
||||||
|
"\0\0\0\0" ; last modified date
|
||||||
|
(int16-to-bytes iblock-parent)))
|
||||||
|
|
||||||
|
(fn Prodos.generate-volume-header [self ?overrides]
|
||||||
|
(local overrides (or ?overrides {}))
|
||||||
|
(local name (or overrides.name self.root.name))
|
||||||
|
(..
|
||||||
|
(int8-to-bytes (bit.bor (bit.lshift self.storage-type.volume-header 4) (length name)))
|
||||||
|
name
|
||||||
|
(string.rep "\0" (- 15 (length name)))
|
||||||
|
"\0\0\0\0\0\0\0\0" ; reserved
|
||||||
|
"\0\0\0\0" ; created date
|
||||||
|
(int8-to-bytes 36) ; version
|
||||||
|
(int8-to-bytes 0) ; min-version
|
||||||
|
(int8-to-bytes 0x01) ; access (read-only, locked)
|
||||||
|
(int8-to-bytes 0x27)
|
||||||
|
(int8-to-bytes 0x0d)
|
||||||
|
(int16-to-bytes (or overrides.file-count self.root.file-count))
|
||||||
|
(int16-to-bytes (or overrides.bitmap-pointer self.root.bitmap-pointer))
|
||||||
|
(int16-to-bytes 280)))
|
||||||
|
|
||||||
|
(fn Prodos.update-volume-header [self ?overrides]
|
||||||
|
(local block (-> (self:block 2) (splice 4 (self:generate-volume-header ?overrides))))
|
||||||
|
(self:set-block 2 block)
|
||||||
|
(self:parse-structure))
|
||||||
|
|
||||||
|
(fn Prodos.add-file [self filename type aux bytes]
|
||||||
|
(assert self.next-free)
|
||||||
|
(local iblock self.next-free.iblock)
|
||||||
|
(var block (self:block iblock))
|
||||||
|
(local file-entry (self:generate-file-entry iblock filename type aux bytes))
|
||||||
|
(print (length file-entry) file-entry)
|
||||||
|
(set block (splice block self.next-free.entry.entry-offset file-entry))
|
||||||
|
(self:set-block iblock block)
|
||||||
|
(self:update-volume-header {:file-count (+ self.root.file-count 1)}))
|
||||||
|
|
||||||
|
Prodos
|
|
@ -33,10 +33,7 @@
|
||||||
(bit.bor (if is-set orval 0))))
|
(bit.bor (if is-set orval 0))))
|
||||||
|
|
||||||
(fn set-tile-bit [tile ibyte ibit is-set]
|
(fn set-tile-bit [tile ibyte ibit is-set]
|
||||||
(..
|
(util.splice tile ibyte (string.char (set-bit tile ibyte ibit is-set))))
|
||||||
(tile:sub 1 ibyte)
|
|
||||||
(string.char (set-bit tile ibyte ibit is-set))
|
|
||||||
(tile:sub (+ ibyte 2))))
|
|
||||||
|
|
||||||
(fn draw-bit-color [bit x y]
|
(fn draw-bit-color [bit x y]
|
||||||
(local (bgcolor color) (tiledraw.pal-from-bit bit))
|
(local (bgcolor color) (tiledraw.pal-from-bit bit))
|
||||||
|
|
|
@ -47,17 +47,12 @@
|
||||||
(cells 16 ["TOTAL" style.inverse] "TOO MANY" ["* MAGIC *" style.flashing] "ALL@ONCE")
|
(cells 16 ["TOTAL" style.inverse] "TOO MANY" ["* MAGIC *" style.flashing] "ALL@ONCE")
|
||||||
(cells 17) (cells 18) (cells 19) (cells 20)])
|
(cells 17) (cells 18) (cells 19) (cells 20)])
|
||||||
|
|
||||||
(fn splice [bytes offset str]
|
|
||||||
(.. (bytes:sub 1 offset)
|
|
||||||
str
|
|
||||||
(bytes:sub (+ (length str) offset 1))))
|
|
||||||
|
|
||||||
(fn bytes-from-lines [lines]
|
(fn bytes-from-lines [lines]
|
||||||
(var bytes (string.rep (astr " ") 0x400))
|
(var bytes (string.rep (astr " ") 0x400))
|
||||||
(each [y line (ipairs lines)]
|
(each [y line (ipairs lines)]
|
||||||
(local offset (+ (* (math.floor (/ (- y 1) 8)) 0x28)
|
(local offset (+ (* (math.floor (/ (- y 1) 8)) 0x28)
|
||||||
(* (% (- y 1) 8) 0x80)))
|
(* (% (- y 1) 8) 0x80)))
|
||||||
(set bytes (splice bytes offset line)))
|
(set bytes (util.splice bytes offset line)))
|
||||||
bytes)
|
bytes)
|
||||||
|
|
||||||
(textorg:append [:bytes (bytes-from-lines (generate-boss-screen-lines))])
|
(textorg:append [:bytes (bytes-from-lines (generate-boss-screen-lines))])
|
||||||
|
|
19
game/disk.fnl
Normal file
19
game/disk.fnl
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
(local asm (require :asm.asm))
|
||||||
|
(local Prodos (require :asm.prodos))
|
||||||
|
(local {: basic} (require :asm.tape))
|
||||||
|
|
||||||
|
(local prg (basic (asm.new)))
|
||||||
|
(local org (prg:org 0x801))
|
||||||
|
|
||||||
|
(org:append [:basic
|
||||||
|
[10 :print "\"HELLO FROM A GENERATED DISK IMAGE!\""]
|
||||||
|
[20 :goto :10]])
|
||||||
|
|
||||||
|
(prg:assemble)
|
||||||
|
|
||||||
|
(local disk (Prodos "ProDOS_2_4_2.dsk"))
|
||||||
|
(disk:add-file "STARTUP" Prodos.file-type.BAS 0x801 org.block.bytes)
|
||||||
|
(disk:update-volume-header {:name "NEUT.TOWER"})
|
||||||
|
(pp disk)
|
||||||
|
(disk:write "Test.dsk")
|
||||||
|
|
20
lib/util.fnl
20
lib/util.fnl
|
@ -13,6 +13,21 @@
|
||||||
(string.char (lo i)))
|
(string.char (lo i)))
|
||||||
(fn int16-to-bytes [i]
|
(fn int16-to-bytes [i]
|
||||||
(string.char (lo i) (hi i)))
|
(string.char (lo i) (hi i)))
|
||||||
|
(fn int24-to-bytes [i]
|
||||||
|
(string.char (lo i) (hi i) (bit.band (bit.rshift i 16) 0xff)))
|
||||||
|
(fn bytes-to-uint8 [b ?offset]
|
||||||
|
(string.byte b (+ 1 (or ?offset 0)) (+ 1 (or ?offset 0))))
|
||||||
|
(fn bytes-to-uint16 [b ?offset]
|
||||||
|
(local (lo hi) (string.byte b (+ 1 (or ?offset 0)) (+ 2 (or ?offset 0))))
|
||||||
|
(bit.bor lo (bit.lshift hi 8)))
|
||||||
|
(fn bytes-to-uint24 [b ?offset]
|
||||||
|
(local (lo mid hi) (string.byte b (+ 1 (or ?offset 0)) (+ 3 (or ?offset 0))))
|
||||||
|
(bit.bor lo (bit.lshift mid 8) (bit.lshift hi 16)))
|
||||||
|
|
||||||
|
(fn splice [bytes offset str]
|
||||||
|
(.. (bytes:sub 1 offset)
|
||||||
|
str
|
||||||
|
(bytes:sub (+ (length str) offset 1))))
|
||||||
|
|
||||||
(fn reload [modname]
|
(fn reload [modname]
|
||||||
(tset package.loaded modname nil)
|
(tset package.loaded modname nil)
|
||||||
|
@ -61,5 +76,8 @@
|
||||||
|
|
||||||
(fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...)))
|
(fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...)))
|
||||||
|
|
||||||
{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson : waitfor : in-coro}
|
{: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
|
||||||
|
: splice : lo : hi
|
||||||
|
: reload : hotswap : swappable :require swappable-require
|
||||||
|
: readjson : writejson : waitfor : in-coro}
|
||||||
|
|
||||||
|
|
|
@ -41,7 +41,7 @@
|
||||||
(set bytes-to-write (bytes-to-write:sub 11))
|
(set bytes-to-write (bytes-to-write:sub 11))
|
||||||
(set addrout (+ addrout 10))))
|
(set addrout (+ addrout 10))))
|
||||||
:monitor (fn [self] (self:cmd "CALL-151"))
|
:monitor (fn [self] (self:cmd "CALL-151"))
|
||||||
:stub (fn [self org post-debug-stub]) ; todo
|
; :stub (fn [self org post-debug-stub]) ; todo
|
||||||
})
|
})
|
||||||
|
|
||||||
(command.add #(not (machine:connected?)) {
|
(command.add #(not (machine:connected?)) {
|
||||||
|
|
37
todo.txt
37
todo.txt
|
@ -1,3 +1,40 @@
|
||||||
|
FLOPPY DISK IDEAS:
|
||||||
|
* I am not going to write my own DOS
|
||||||
|
* I will use ProDOS - BOOTI-compatible, modern
|
||||||
|
* ProDOS 2.4.2 - https://prodos8.com/
|
||||||
|
* Generate file(s) to be injected into a blank bootable ProDOS disk image
|
||||||
|
|
||||||
|
thinking:
|
||||||
|
neut.tower contains all code / data
|
||||||
|
loader.system contains a small program that maps offsets of 512-byte blocks to memory addresses
|
||||||
|
- is loaded to 0x2000 & will be wiped by gfx? No, PRODOS is loaded at $2000 and moved
|
||||||
|
- no, XXX.SYSTEM is loaded to 0x2000 as well
|
||||||
|
- Alternately, we could write one program that batch-loads the whole game into $2000 and moves it to where it belongs?
|
||||||
|
- How big is the game with all levels? Could we load the whole thing into consecutive memory starting at $4000?
|
||||||
|
- (I don't think this would work on 32kb tape-loaded machines...)
|
||||||
|
- With ProDOS I can assume 64kb
|
||||||
|
prodos claims:
|
||||||
|
$bf00-$ffff - ProDOS
|
||||||
|
$9600-$bf00 - BASIC.SYSTEM - don't care?
|
||||||
|
$0100-$0800 - "other use or reserved"
|
||||||
|
$3A-$3F - used by disk routines, unsafe
|
||||||
|
$40-$4F - used by ProDOS but preserved, safe to use
|
||||||
|
|
||||||
|
system bitmap: marks pages of memory as "not valid to allocate a file buffer"
|
||||||
|
- loader will have to protect memory that it will be moving game code to?
|
||||||
|
|
||||||
|
https://prodos8.com/docs/techref/calls-to-the-mli/
|
||||||
|
the existence of SET_BUF should mean we can load directly to the memory
|
||||||
|
we care about? orr I guess 512 bytes is housekeeping stuff (index block)
|
||||||
|
|
||||||
|
16kb version - $0000-$4000 - no we need at least 32kb
|
||||||
|
there's basically only 5kb of code space for an hgr game?
|
||||||
|
$0000-$03ff 0kb-1kb - zp, stack, input buffer, DOS
|
||||||
|
$0400-$07ff 1kb-2kb - text page 1
|
||||||
|
$0800-$0bff 2kb-3kb - text page 2
|
||||||
|
$0c00-$1fff 3kb-8kb - free space
|
||||||
|
$2000-$4000 8kb-16kb - hgr gfx page 1
|
||||||
|
|
||||||
Game:
|
Game:
|
||||||
* level loading
|
* level loading
|
||||||
* Title screen
|
* Title screen
|
||||||
|
|
Loading…
Reference in a new issue