Title screen, screen editor, and new slim loader

This commit is contained in:
Jeremy Penner 2021-01-16 21:40:04 -05:00
parent 049d388365
commit 46ca8560e2
14 changed files with 220 additions and 37 deletions

Binary file not shown.

View file

@ -123,6 +123,10 @@
(do (tset block.symbols dat (+ (length block.pdats) 1))
(when (= (dat:sub 1 2) "G-")
(tset block.globals dat true)))
(not= (type dat) :table)
(error (.. "Invalid operation " dat))
(let [opcode (. dat 1)
parser (. dat-parser opcode)
pdat

View file

@ -6,7 +6,9 @@
(local lume (require :lib.lume))
(local prodos-mli :0xbf00)
(fn Prodos.str [str] [:block [:db (length str)] [:bytes str]])
(fn Prodos.install-words [vm]
(fn vm.pstr [self str] (self:anon (Prodos.str str)))
(fn prodos-call [cmd param-addr crash-on-fail]
[:block
[:jsr prodos-mli]

View file

@ -53,8 +53,9 @@
(error (.. "VM can't parse " (fv bytecode)))))
block))
(fn mk-vm [prg options]
(local code1 (prg:org 0x4000))
(fn mk-vm [prg ?options]
(local options (or ?options {}))
(local code1 (prg:org (or options.org 0x4000)))
(install-vm-parser prg)
(local vm {
:IP :0x60

17
editor/brushedit.fnl Normal file
View file

@ -0,0 +1,17 @@
(local TileView (require :editor.tileedit))
(local tiledraw (require :editor.tiledraw))
(local tiles (require :game.tiles))
(local style (require :core.style))
(local BrushEditView (TileView:extend))
(fn BrushEditView.spritegen [self] tiledraw.char-to-sprite)
(fn BrushEditView.tilesize [self] (values 8 8))
(fn BrushEditView.tilekeys [self] [:gfx :mask])
(fn BrushEditView.map-bitxy [self x y] (values y x))
(fn BrushEditView.filename [self] "editor/brushes.json")
(fn BrushEditView.get_name [self] "Brush Editor")
(fn BrushEditView.draw-tile-flags [self x y])
BrushEditView

1
editor/brushes.json Normal file
View file

@ -0,0 +1 @@
[{"mask":"FFFFFFFFFFFFFFFF","gfx":"D5D5D5D5D5D5D5D5","flags":[]},{"mask":"00008F8F8F000000","gfx":"00000A0A0A000000","flags":[]},{"mask":"00008F8F8F000000","gfx":"00008A8A8A000000","flags":[]},{"mask":"0000BCBCBC000000","gfx":"0000141414000000","flags":[]},{"mask":"0000BCBCBC000000","gfx":"0000949494000000","flags":[]},{"mask":"0000000C0C000000","gfx":"0000000C0C000000","flags":[]},{"mask":"00000C1E1E0C0000","flags":[],"gfx":"0000000000000000"},{"mask":"3E7F7F7F7F7F7F3E","gfx":"3E7F7F7F7F7F7F3E","flags":[]}]

View file

@ -16,6 +16,7 @@
(attach-imstate self))
(fn GraphicsEditView.spritegen [self] tiledraw.tile-to-sprite)
(fn GraphicsEditView.tilesize [self] (values 16 16))
(fn GraphicsEditView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) 8)))
(fn GraphicsEditView.filename [self] tiles.fn-tiles)
(fn GraphicsEditView.reload [self]
(self.tilecache:load (tiles.loadgfx (self:filename))))

View file

@ -2,6 +2,7 @@
(local util (require :lib.util))
(local TileView (require :editor.tileedit))
(local MapEditView (require :editor.mapedit))
(local ScreenEditView (require :editor.screenedit))
(local PortraitView (require :editor.portraitedit))
(local {: cmd-predicate} (util.require :editor.imstate))
(local core (require :core))
@ -10,26 +11,30 @@
(local common (require :core.common))
(let [commands {}]
(each [_ name (ipairs [:tile :portrait :font])]
(each [_ name (ipairs [:tile :portrait :font :brush])]
(local cls (require (.. "editor." name "edit")))
(tset commands (.. "honeylisp:" name "-editor") (fn []
(local node (core.root_view:get_active_node))
(node:add_view (cls)))))
(command.add nil commands))
(command.add nil {
"honeylisp:map-editor" (fn []
(core.command_view:enter "Open Map"
(local fileeditors
{:map {:view MapEditView :filefilter "^game/map%d+%.json"}
:screen {:view ScreenEditView :filefilter "^game/.*%.screen"}})
(each [type {: view : filefilter} (pairs fileeditors)]
(command.add nil
{(.. "honeylisp:" type "-editor") (fn []
(core.command_view:enter (.. "Open " type)
(fn [text item]
(local node (core.root_view:get_active_node))
(node:add_view (MapEditView (or (and item item.text) text))))
(node:add_view (view (or (and item item.text) text))))
(fn [text]
(local files [])
(each [_ item (pairs core.project_files)]
(when (and (= item.type :file) (item.filename:find "^game/map%d+%.json"))
(when (and (= item.type :file) (item.filename:find filefilter))
(table.insert files item.filename)))
(common.fuzzy_match files text))))
})
(common.fuzzy_match files text))))}))
(command.add (cmd-predicate :editor.gfxedit) {
"graphics-editor:save" (fn [] (core.active_view:save) (core.log "Saved"))
@ -41,7 +46,7 @@
"tileedit:copy"
#(system.set_clipboard (: (core.active_view:tile) :tohex))
"tileedit:paste"
#(when (= (length (system.get_clipboard)) 64)
#(when (= (length (system.get_clipboard)) (* (core.active_view:tilebytelen) 2))
(core.active_view:update-tile (: (system.get_clipboard) :fromhex)))
})
(keymap.add {

96
editor/screenedit.fnl Normal file
View file

@ -0,0 +1,96 @@
(local GraphicsEditView (require :editor.gfxedit))
(local util (require :lib.util))
(local lume (require :lib.lume))
(local style (require :core.style))
(local {: char-to-sprite : scanline-to-sprite : screen-y-to-offset} (util.require :editor.tiledraw))
(local {: mouse-inside : activate : active? : checkbox : textfield : textbutton} (util.require :editor.imstate))
(local ScreenEditView (GraphicsEditView:extend))
(local screen-scale 4)
(local screenw 280)
(local screenh 192)
(fn ScreenEditView.new [self filename]
(ScreenEditView.super.new self)
(set self.screenfilename filename)
(set self.scanlines [])
(self:reload))
(fn gfxshift [byte offset]
(local pixels (bit.band (string.byte byte) 0x7f))
(local color (bit.band (string.byte byte) 0x80))
(bit.bor color
(if (> offset 0) (bit.band (bit.lshift pixels offset) 0x7f)
(bit.rshift pixels (- offset)))))
(fn brush-mask-at [brush xoffset y]
(values (gfxshift (brush.gfx:sub y y) xoffset) (gfxshift (brush.mask:sub y y) xoffset)))
(fn paint-byte [src brush mask]
(if (not= (bit.band mask 0x7f) 0)
(-> src
(bit.band (bit.bxor 0xff mask))
(bit.bor brush))
src))
(fn paint-byte-at [screen brush y xbyte xoffset yoffset]
(if (and (>= xbyte 0) (< xbyte 40) (>= y 0) (< y screenh))
(let [ibyte (+ (screen-y-to-offset y) xbyte)
srcbyte (screen:sub (+ ibyte 1) (+ ibyte 1))
painted (paint-byte (string.byte srcbyte) (brush-mask-at brush xoffset yoffset))]
(util.splice screen ibyte (string.char painted)))
screen))
(fn paint [screen brush x y]
(var result screen)
(for [row y (+ y 7)]
(local xbyte (math.floor (/ x 7)))
(local xoffset-left (% x 7))
(local xoffset-right (- xoffset-left 7))
(local yoffset (+ (- row y) 1))
(set result (paint-byte-at result brush row xbyte xoffset-left yoffset))
(set result (paint-byte-at result brush row (+ xbyte 1) xoffset-right yoffset)))
result)
(fn ScreenEditView.draw-screen-editor [self x y]
(local (w h) (values (* screenw screen-scale) (* screenh screen-scale)))
(activate self :screen x y w h)
(var screen self.screen)
(when (and self.itile (mouse-inside x y w h))
(local mx (math.floor (/ (- (love.mouse.getX) x) screen-scale)))
(local my (math.floor (/ (- (love.mouse.getY) y) screen-scale)))
(set screen (paint screen (. self.tilecache.tiles self.itile) (bit.band (- mx 3) 0xfffe) (- my 4)))
(when (active? self :screen) (set self.screen screen)))
(for [scany 0 (- screenh 1)]
(local scanline (or (. self.scanlines scany) {}))
(local ibyte (screen-y-to-offset scany))
(local linehash (screen:sub (+ ibyte 1) (+ ibyte 40)))
(when (not= scanline.linehash linehash)
(set scanline.linehash linehash)
(set scanline.sprite (scanline-to-sprite screen scany))
(tset self.scanlines scany scanline))
(love.graphics.draw scanline.sprite x (+ y (* scany screen-scale)) 0 screen-scale screen-scale)))
(fn ScreenEditView.reload [self]
(ScreenEditView.super.reload self)
(local (loaded screen) (pcall #(util.readjson self.screenfilename)))
(set self.screen
(if (not loaded) (string.rep "\0" 0x2000)
(screen:fromhex))))
(fn ScreenEditView.save [self]
(util.writejson self.screenfilename (self.screen:tohex)))
(fn ScreenEditView.draw [self]
(self:draw_background style.background)
(love.graphics.setColor 1 1 1 1)
(self:draw-screen-editor (+ self.position.x 10) (+ self.position.y 10))
(self:draw-tile-selector (+ self.position.x 10) (+ self.position.y 20 (* screenh screen-scale)) (- self.size.x 20)))
(fn ScreenEditView.filename [self] "editor/brushes.json")
(fn ScreenEditView.spritegen [self] char-to-sprite)
(fn ScreenEditView.tilesize [self] (values 8 8))
(fn ScreenEditView.get_name [self] (.. "Screen: " self.screenfilename))
ScreenEditView

View file

@ -70,6 +70,28 @@
(fn tile-to-sprite [tile] (if tile (tilestrip-to-sprite [tile]) (make-canvas 14 16 #nil)))
(fn screen-y-to-offset [y]
(var offset (* (% y 8) 0x400))
(local ybox (math.floor (/ y 8)))
(local ysection (match (math.floor (/ ybox 8))
0 0x0000
1 0x0028
2 0x0050))
(+ offset ysection (* (% ybox 8) 0x80)))
(fn draw-scanline [screen y ydest]
(local ibyte (+ 1 (screen-y-to-offset y)))
(var state nil) (var prevpal nil)
(for [x 0 39]
(set (state prevpal) (draw-byte screen (+ ibyte x) (* x 7) ydest state prevpal))))
(fn scanline-to-sprite [screen y]
(make-canvas 280 1 (fn [canvas] (draw-scanline screen y 0))))
(fn screen-to-sprite [screen]
(make-canvas 280 192 (fn [canvas]
(for [y 0 191] (draw-scanline screen y y)))))
(fn portrait-to-sprite [gfx]
(local top (tilestrip-to-sprite [(gfx:sub 1 32) (gfx:sub 65 96)]))
(local bottom (tilestrip-to-sprite [(gfx:sub 33 64) (gfx:sub 97 128)]))
@ -79,8 +101,9 @@
(fn char-to-sprite [gfx]
(make-canvas 7 8 (fn [canvas]
(when gfx
(for [y 0 7]
(draw-byte gfx (+ y 1) 0 y)))))
(draw-byte gfx (+ y 1) 0 y))))))
(fn TileCache [tiles ?spritegen]
{: tiles
@ -108,5 +131,6 @@
(tset self.tilesprites key (self.spritegen (. self.tiles itile (or ?key :gfx)))))
(. self.tilesprites key))})
{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : pal-from-bit : pal-from-byte : TileCache}
{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : scanline-to-sprite
: screen-y-to-offset : pal-from-bit : pal-from-byte : TileCache : make-canvas : draw-byte}

View file

@ -87,9 +87,6 @@
(fn TileView.save [self] (tiles.savegfx (self:filename) self.tilecache.tiles))
(fn TileView.draw-neut-tile-selector [self x y]
(self:draw-tile-selector x (- self.size.x 20) :neut))
(fn TileView.draw [self]
(self:draw_background style.background)
(local (x y) (values (+ self.position.x 10) (+ self.position.y 10)))

View file

@ -1,4 +1,5 @@
(local asm (require :asm.asm))
(local VM (require :asm.vm))
(local Prodos (require :asm.prodos))
(local util (require :lib.util))
(local {: lo : hi} util)
@ -30,8 +31,12 @@
[:bne :ld-src]
:done])
(fn prg-loader [org game]
(fn create-sys-loader [disk filename game]
(local blocks [])
(local prg (asm.new game))
(local org (prg:org 0x2000))
(org: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))
@ -39,19 +44,48 @@
(org:append (org-loader block)))
(org:append [:jmp game.start-symbol])
(each [_ block (ipairs blocks)]
(org:append (.. :loader- block.addr) [:bytes block.bytes])))
(org:append (.. :loader- block.addr) [:bytes block.bytes]))
(prg:assemble)
(disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 org.block.bytes))
(local game (util.reload :game))
(local prg (asm.new game))
(local org (prg:org 0x2000))
(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)
(org:append :loader-main)
(set prg.start-symbol :loader-main)
(prg-loader org game)
(prg:assemble)
(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)
(local disk (Prodos "ProDOS_Blank.dsk"))
(disk:add-file "NEUT.SYSTEM" Prodos.file-type.SYS 0x2000 org.block.bytes)
(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")

View file

@ -6,7 +6,7 @@
(each [iflag flag (ipairs flags)]
(tset flag-to-bit flag (bit.lshift 1 (- iflag 1))))
(local encoded-tile-fields [:gfx :neut])
(local encoded-tile-fields [:gfx :neut :mask])
(fn convert [tile field method]
(local oldval (. tile field))
(when oldval

1
game/title.screen Normal file

File diff suppressed because one or more lines are too long