Honeylisp project support, porting Neut Tower

This commit is contained in:
Jeremy Penner 2021-06-25 21:55:15 -04:00
parent d5714f14d4
commit 10b29177a3
18 changed files with 65 additions and 39 deletions

Binary file not shown.

View file

@ -1,7 +1,7 @@
(local tile (require :game.tiles)) (local tile (require :game.tiles))
(local {: vm : mapw : maph : itile : controlstate} (require :bitsy.defs)) (local {: vm : mapw : maph : itile : controlstate} (require :bitsy.defs))
(local {: walkable} tile.flag-to-bit) (local {: walkable} (tile.flag-to-bit))
(vm:word :either= ; target val1 val2 -- f (vm:word :either= ; target val1 val2 -- f
:>rot :over := :>rot := :|) :>rot :over := :>rot := :|)

View file

@ -21,7 +21,7 @@
(command.add nil commands)) (command.add nil commands))
(local fileeditors (local fileeditors
{:screen {:view ScreenEditView :filefilter "^game/.*%.screen"}}) {:screen {:view ScreenEditView :filefilter ".*%.screen"}})
(each [type {: view : filefilter} (pairs fileeditors)] (each [type {: view : filefilter} (pairs fileeditors)]
(command.add nil (command.add nil

View file

@ -93,7 +93,7 @@
(var stripid "") (var stripid "")
(for [mx 1 mapw] (for [mx 1 mapw]
(local itile (self:itile-from-xy mx my)) (local itile (self:itile-from-xy mx my))
(local tile (. self.tilecache.tiles itile :gfx)) (local tile (?. self.tilecache.tiles itile :gfx))
(table.insert tilestrip tile) (table.insert tilestrip tile)
(set stripid (.. stripid (string.char itile)))) (set stripid (.. stripid (string.char itile))))
(var sprite (. self.stripcache stripid)) (var sprite (. self.stripcache stripid))
@ -183,6 +183,11 @@
(when do-new (table.insert object.steps {})) (when do-new (table.insert object.steps {}))
y)) y))
(fn advanced? [object]
(or object.advanced
(and (= object.advanced nil)
object.func)))
(fn MapEditView.draw-object-advanced-editor [self object x y] (fn MapEditView.draw-object-advanced-editor [self object x y]
(let [(func y) (textfield self "Word" object.func x y 100 200) (let [(func y) (textfield self "Word" object.func x y 100 200)
(name y) (textfield self "Name" object.name x (+ y style.padding.y) 100 200) (name y) (textfield self "Name" object.name x (+ y style.padding.y) 100 200)
@ -195,13 +200,13 @@
(fn MapEditView.draw-object-editor [self x y] (fn MapEditView.draw-object-editor [self x y]
(let [object (self:object) (let [object (self:object)
y (if object.advanced y (if (advanced? object)
(self:draw-object-advanced-editor object x y) (self:draw-object-advanced-editor object x y)
(self:draw-object-code-editor object x y)) (self:draw-object-code-editor object x y))
new-flag-name (textbox self :new-flag-name self.new-flag-name x (+ y style.padding.y) 200) new-flag-name (textbox self :new-flag-name self.new-flag-name x (+ y style.padding.y) 200)
(mk-new-flag y) (textbutton self "+ New Flag" (+ x 200 style.padding.x) (+ y style.padding.y)) (mk-new-flag y) (textbutton self "+ New Flag" (+ x 200 style.padding.x) (+ y style.padding.y))
do-delete (textbutton self "Delete" x (+ y 40)) do-delete (textbutton self "Delete" x (+ y 40))
(do-advanced y) (textbutton self (if object.advanced "Simple" "Advanced") (+ x 150) (+ y 40))] (do-advanced y) (textbutton self (if (advanced? object) "Simple" "Advanced") (+ x 150) (+ y 40))]
(set self.new-flag-name new-flag-name) (set self.new-flag-name new-flag-name)
(when mk-new-flag (when mk-new-flag
(when (= files.game.flags nil) (when (= files.game.flags nil)
@ -211,7 +216,7 @@
(when do-delete (when do-delete
(move-object self.level.objects (+ self.iobject 1) self.iobject) (move-object self.level.objects (+ self.iobject 1) self.iobject)
(set self.iobject nil)) (set self.iobject nil))
(when do-advanced (set object.advanced (not object.advanced))) (when do-advanced (set object.advanced (not (advanced? object))))
y)) y))
(fn MapEditView.load-level [self] (fn MapEditView.load-level [self]

View file

@ -79,7 +79,7 @@
(when tile (when tile
(set tile.word (textfield self "Default word" tile.word x y 100 200)) (set tile.word (textfield self "Default word" tile.word x y 100 200))
(set tile.label (textfield self "Label" tile.label x (+ y pixel-size 4) 100 200))) (set tile.label (textfield self "Label" tile.label x (+ y pixel-size 4) 100 200)))
(each [iflag flagname (ipairs tiles.flags)] (each [iflag flagname (ipairs (tiles.flags))]
(self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4)))))) (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
(fn TileView.update-tile [self newtile] (fn TileView.update-tile [self newtile]

View file

@ -73,8 +73,8 @@
(util.nested-tset files [:tilecaches key] (new-cache files.game key))) (util.nested-tset files [:tilecaches key] (new-cache files.game key)))
(. files.tilecaches key)) (. files.tilecaches key))
(fn files.reload [] (fn files.reload [?filename]
(files.load) (files.load ?filename)
(when files.tilecaches (when files.tilecaches
(each [key cache (pairs files.tilecaches)] (each [key cache (pairs files.tilecaches)]
(cache:load (. files.game key))))) (cache:load (. files.game key)))))

View file

@ -1,10 +1,10 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local lume (require :lib.lume)) (local lume (require :lib.lume))
(local files (require :game.files)) (local files (require :game.files))
(local flags [:walkable])
(local flag-to-bit {}) (fn flags [] (or files.game.tileflags [:walkable]))
(each [iflag flag (ipairs flags)] (fn flag-to-bit []
(tset flag-to-bit flag (bit.lshift 1 (- iflag 1)))) (collect [iflag flag (ipairs (flags))] (values flag (bit.lshift 1 (- iflag 1)))))
(fn appendgfx [org gfx ?key ?label-prefix] (fn appendgfx [org gfx ?key ?label-prefix]
(each [_ g (ipairs gfx)] (each [_ g (ipairs gfx)]
@ -13,6 +13,7 @@
(fn appendtiles [org] (fn appendtiles [org]
(local tiles files.game.tiles) (local tiles files.game.tiles)
(local flag-lookup (flag-to-bit))
(org:append [:align 0x100] :tileset) (org:append [:align 0x100] :tileset)
(appendgfx org tiles) (appendgfx org tiles)
(appendgfx org files.game.portraits nil :portrait-) (appendgfx org files.game.portraits nil :portrait-)
@ -20,7 +21,7 @@
(each [_ tile (ipairs tiles)] (each [_ tile (ipairs tiles)]
(var flags 0) (var flags 0)
(each [flag _ (pairs tile.flags)] (each [flag _ (pairs tile.flags)]
(set flags (bit.bor flags (. flag-to-bit flag)))) (set flags (bit.bor flags (. flag-lookup flag))))
(org:append [:db flags]))) (org:append [:db flags])))
(fn append-portraitwords [vm ?overrides] (fn append-portraitwords [vm ?overrides]

View file

@ -4,6 +4,7 @@
(local asm (require :asm.asm)) (local asm (require :asm.asm))
(local VM (require :asm.vm)) (local VM (require :asm.vm))
(local tiles (require :game.tiles)) (local tiles (require :game.tiles))
(local files (require :game.files))
(local Prodos (require :asm.prodos)) (local Prodos (require :asm.prodos))
(local prg (asm.new)) (local prg (asm.new))
@ -133,7 +134,7 @@
(fn append-map [map org label] (fn append-map [map org label]
(org:append (org:append
[:align 0x100] label [:align 0x100] label
[:bytes (map.map:fromhex)] [:bytes map.map]
[:db (length map.objects)] [:db (length map.objects)]
[:dw (tiles.encode-yx map.jaye)] [:dw (tiles.encode-yx map.jaye)]
[:dw (tiles.encode-yx map.neut)] [:dw (tiles.encode-yx map.neut)]
@ -152,10 +153,10 @@
(vm:word :map-specific-move :map 250 :+ :execute) (vm:word :map-specific-move :map 250 :+ :execute)
(vm:word :map-specific-load :map 253 :+ :execute) (vm:word :map-specific-load :map 253 :+ :execute)
(fn deflevel [mapfile label] (fn deflevel [ilevel label]
(local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay (local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay
(local org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation (local org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation
(local map (readjson mapfile)) (local map (. files.game.levels ilevel))
(local entity (require :neuttower.entity)) (local entity (require :neuttower.entity))
(append-map map org label) (append-map map org label)
(entity.append-from-map map org label) (entity.append-from-map map org label)
@ -163,7 +164,7 @@
level) level)
(fn say-runon [portrait ...] (fn say-runon [portrait ...]
(local result [:vm (.. :draw-p portrait)]) (local result [:vm (.. :draw-portrait- portrait)])
(local lines [...]) (local lines [...])
(local ilineOffset (if (< (length lines) 4) 1 0)) (local ilineOffset (if (< (length lines) 4) 1 0))
(each [iline line (ipairs lines)] (each [iline line (ipairs lines)]
@ -175,10 +176,9 @@
(table.insert result :dismiss-dialog) (table.insert result :dismiss-dialog)
result) result)
(local tilelist (tiles.loadgfx tiles.fn-tiles)) (fn itile [label] (tiles.find-itile files.game.tiles label))
(fn itile [label] (tiles.find-itile tilelist label))
(set vm.code org.code) (set vm.code org.code)
{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : tilelist : controlstate} {: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : controlstate}

1
neuttower/game.json Normal file

File diff suppressed because one or more lines are too long

View file

@ -1,6 +1,7 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local {: lo : hi : readjson} util) (local {: lo : hi : readjson} util)
(local tile (util.reload :game.tiles)) (local tile (util.reload :game.tiles))
(local files (require :game.files))
(local {: prg : vm : org} (util.reload :neuttower.defs)) (local {: prg : vm : org} (util.reload :neuttower.defs))
(local disk (util.reload :neuttower.disk)) (local disk (util.reload :neuttower.disk))
@ -15,8 +16,8 @@
(tile.appendtiles org.code) (tile.appendtiles org.code)
(org.code:append [:align 0x100] :font) (org.code:append [:align 0x100] :font)
(tile.appendgfx org.code (tile.loadgfx tile.fn-font)) (tile.appendgfx org.code files.game.font)
(tile.append-portraitwords vm {:pneut #[:vm :chuck-mode :get (vm:if [:lit :pchuck] [:lit :pneut])]}) (tile.append-portraitwords vm {:neut #[:vm :chuck-mode :get (vm:if [:lit :portrait-chuck] [:lit :portrait-neut])]})
(util.reload :neuttower.level1) (util.reload :neuttower.level1)
(util.reload :neuttower.level2) (util.reload :neuttower.level2)

View file

@ -1,12 +1,13 @@
(local {: readjson} (require :lib.util)) (local {: readjson} (require :lib.util))
(local {: deflevel : say : itile : controlstate : tilelist} (require :neuttower.defs)) (local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local {: decode-itile : encode-yx} (require :game.tiles)) (local {: decode-itile : encode-yx} (require :game.tiles))
(local level (deflevel "game/map1.json" :level1)) (local files (require :game.files))
(local level (deflevel 1 :level1))
(local vm level.vm) (local vm level.vm)
(let [map (readjson "game/map1.json") (let [map (. files.game.levels 1)
maptiles (map.map:fromhex) maptiles map.map
furniture-yx []] furniture-yx []]
(for [ibyte 1 (length maptiles)] (for [ibyte 1 (length maptiles)]
(let [btile (maptiles:sub ibyte ibyte) (let [btile (maptiles:sub ibyte ibyte)
@ -14,7 +15,7 @@
itile (+ (decode-itile enctile) 1) itile (+ (decode-itile enctile) 1)
mx (+ (% (- ibyte 1) 20) 1) mx (+ (% (- ibyte 1) 20) 1)
my (- 12 (math.floor (/ (- ibyte 1) 20)))] my (- 12 (math.floor (/ (- ibyte 1) 20)))]
(when (. tilelist itile :flags :debris) (when (. files.game.tiles itile :flags :debris)
(table.insert furniture-yx (encode-yx {:x mx :y my}))))) (table.insert furniture-yx (encode-yx {:x mx :y my})))))
(vm.code:append :furniture-yx) (vm.code:append :furniture-yx)
(for [_ 1 10] (for [_ 1 10]

View file

@ -1,6 +1,6 @@
(local {: deflevel : say : itile} (require :neuttower.defs)) (local {: deflevel : say : itile} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local level (deflevel "game/map2.json" :level2)) (local level (deflevel 2 :level2))
(local vm level.vm) (local vm level.vm)
level level

View file

@ -1,8 +1,8 @@
(local {: deflevel : say : itile : controlstate} (require :neuttower.defs)) (local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local level (deflevel "game/map3.json" :level3)) (local level (deflevel 3 :level3))
(local tile (require :game.tiles)) (local tile (require :game.tiles))
(local {: walkable : neutable : debris} tile.flag-to-bit) (local {: walkable : neutable : debris} (tile.flag-to-bit))
(local vm level.vm) (local vm level.vm)

View file

@ -1,6 +1,6 @@
(local {: deflevel : say : itile} (require :neuttower.defs)) (local {: deflevel : say : itile} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local level (deflevel "game/map4.json" :level4)) (local level (deflevel 4 :level4))
(local vm level.vm) (local vm level.vm)
(vm:word :term-dual-link (vm:word :term-dual-link

View file

@ -1,14 +1,15 @@
(local {: deflevel : say : itile : controlstate : tilelist} (require :neuttower.defs)) (local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local tile (require :game.tiles)) (local tile (require :game.tiles))
(local files (require :game.files))
(local {: notes} (require :neuttower.boop)) (local {: notes} (require :neuttower.boop))
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit) (local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
(local level (deflevel "game/map5.json" :level5)) (local level (deflevel 5 :level5))
(local vm level.vm) (local vm level.vm)
(vm:word :snd-dropgarbage (notes [:a1] 0x02 0xf0)) (vm:word :snd-dropgarbage (notes [:a1] 0x02 0xf0))
(vm.code:append :debristiles) (vm.code:append :debristiles)
(each [itile tiledef (ipairs tilelist)] (each [itile tiledef (ipairs files.game.tiles)]
(when tiledef.flags.debris (when tiledef.flags.debris
(vm.code:append [:db (tile.encode-itile itile)]))) (vm.code:append [:db (tile.encode-itile itile)])))
(vm:word :randomgarbage :rnd 0x03 :& :lit :debristiles :+ :bget) (vm:word :randomgarbage :rnd 0x03 :& :lit :debristiles :+ :bget)

View file

@ -1,8 +1,8 @@
(local {: deflevel : say : say-runon : itile : controlstate} (require :neuttower.defs)) (local {: deflevel : say : say-runon : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity)) (local {: ev} (require :neuttower.entity))
(local tile (require :game.tiles)) (local tile (require :game.tiles))
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit) (local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
(local level (deflevel "game/map6.json" :level6)) (local level (deflevel 6 :level6))
(local vm level.vm) (local vm level.vm)
(vm:word :linkloop ; e -- e (vm:word :linkloop ; e -- e

View file

@ -1,7 +1,7 @@
(local tile (require :game.tiles)) (local tile (require :game.tiles))
(local {: vm : mapw : maph : itile : controlstate} (require :neuttower.defs)) (local {: vm : mapw : maph : itile : controlstate} (require :neuttower.defs))
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit) (local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
(vm:word :movement-dir ; key -- dyx (vm:word :movement-dir ; key -- dyx
(vm:case [(string.byte "I") 0xff00] (vm:case [(string.byte "I") 0xff00]

View file

@ -5,8 +5,24 @@
(require :link.command) (require :link.command)
(local core (require :core)) (local core (require :core))
(local command (require :core.command)) (local command (require :core.command))
(local common (require :core.common))
(local keymap (require :core.keymap)) (local keymap (require :core.keymap))
(local translate (require :core.doc.translate)) (local translate (require :core.doc.translate))
(local files (require :game.files))
(command.add nil {
"honeylisp:open-project" (fn []
(core.command_view:enter "Open Project"
(fn [text item]
(files.reload (or (and item item.text) text))
(core.log "Opened"))
(fn [text]
(local files [])
(each [_ item (pairs core.project_files)]
(print item.filename)
(when (and (= item.type :file) (item.filename:find "^.*/game%.json"))
(table.insert files item.filename)))
(common.fuzzy_match files text))))})
(command.add #(link.machine:connected?) { (command.add #(link.machine:connected?) {
"honeylisp:upload" (fn [] "honeylisp:upload" (fn []