SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Honeylisp project support, porting Neut Tower

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
8Bitsy.dsk
View file

Binary file not shown.

2
bitsy/player.fnl
View file

@ -1,7 +1,7 @@
(local tile (require :game.tiles))
(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
:>rot :over := :>rot := :|)

2
editor/init.fnl
View file

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

13
editor/mapedit.fnl
View file

@ -93,7 +93,7 @@
(var stripid "")
(for [mx 1 mapw]
(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)
(set stripid (.. stripid (string.char itile))))
(var sprite (. self.stripcache stripid))
@ -183,6 +183,11 @@
(when do-new (table.insert object.steps {}))
y))
(fn advanced? [object]
(or object.advanced
(and (= object.advanced nil)
object.func)))
(fn MapEditView.draw-object-advanced-editor [self object x y]
(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)
@ -195,13 +200,13 @@
(fn MapEditView.draw-object-editor [self x y]
(let [object (self:object)
y (if object.advanced
y (if (advanced? object)
(self:draw-object-advanced-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)
(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-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)
(when mk-new-flag
(when (= files.game.flags nil)
@ -211,7 +216,7 @@
(when do-delete
(move-object self.level.objects (+ self.iobject 1) self.iobject)
(set self.iobject nil))
(when do-advanced (set object.advanced (not object.advanced)))
(when do-advanced (set object.advanced (not (advanced? object))))
y))
(fn MapEditView.load-level [self]

2
editor/tileedit.fnl
View file

@ -79,7 +79,7 @@
(when tile
(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)))
(each [iflag flagname (ipairs tiles.flags)]
(each [iflag flagname (ipairs (tiles.flags))]
(self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
(fn TileView.update-tile [self newtile]

4
game/files.fnl
View file

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

11
game/tiles.fnl
View file

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

14
neuttower/defs.fnl
View file

@ -4,6 +4,7 @@
(local asm (require :asm.asm))
(local VM (require :asm.vm))
(local tiles (require :game.tiles))
(local files (require :game.files))
(local Prodos (require :asm.prodos))
(local prg (asm.new))
@ -133,7 +134,7 @@
(fn append-map [map org label]
(org:append
[:align 0x100] label
[:bytes (map.map:fromhex)]
[:bytes map.map]
[:db (length map.objects)]
[:dw (tiles.encode-yx map.jaye)]
[:dw (tiles.encode-yx map.neut)]
@ -152,10 +153,10 @@
(vm:word :map-specific-move :map 250 :+ :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 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))
(append-map map org label)
(entity.append-from-map map org label)
@ -163,7 +164,7 @@
level)
(fn say-runon [portrait ...]
(local result [:vm (.. :draw-p portrait)])
(local result [:vm (.. :draw-portrait- portrait)])
(local lines [...])
(local ilineOffset (if (< (length lines) 4) 1 0))
(each [iline line (ipairs lines)]
@ -175,10 +176,9 @@
(table.insert result :dismiss-dialog)
result)
(local tilelist (tiles.loadgfx tiles.fn-tiles))
(fn itile [label] (tiles.find-itile tilelist label))
(fn itile [label] (tiles.find-itile files.game.tiles label))
(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
View file

File diff suppressed because one or more lines are too long

5
neuttower/init.fnl
View file

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

11
neuttower/level1.fnl
View file

@ -1,12 +1,13 @@
(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 {: 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)
(let [map (readjson "game/map1.json")
maptiles (map.map:fromhex)
(let [map (. files.game.levels 1)
maptiles map.map
furniture-yx []]
(for [ibyte 1 (length maptiles)]
(let [btile (maptiles:sub ibyte ibyte)
@ -14,7 +15,7 @@
itile (+ (decode-itile enctile) 1)
mx (+ (% (- ibyte 1) 20) 1)
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})))))
(vm.code:append :furniture-yx)
(for [_ 1 10]

2
neuttower/level2.fnl
View file

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

4
neuttower/level3.fnl
View file

@ -1,8 +1,8 @@
(local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
(local {: ev} (require :neuttower.entity))
(local level (deflevel "game/map3.json" :level3))
(local level (deflevel 3 :level3))
(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)

2
neuttower/level4.fnl
View file

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

9
neuttower/level5.fnl
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 tile (require :game.tiles))
(local files (require :game.files))
(local {: notes} (require :neuttower.boop))
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit)
(local level (deflevel "game/map5.json" :level5))
(local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
(local level (deflevel 5 :level5))
(local vm level.vm)
(vm:word :snd-dropgarbage (notes [:a1] 0x02 0xf0))
(vm.code:append :debristiles)
(each [itile tiledef (ipairs tilelist)]
(each [itile tiledef (ipairs files.game.tiles)]
(when tiledef.flags.debris
(vm.code:append [:db (tile.encode-itile itile)])))
(vm:word :randomgarbage :rnd 0x03 :& :lit :debristiles :+ :bget)

4
neuttower/level6.fnl
View file

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

2
neuttower/player.fnl
View file

@ -1,7 +1,7 @@
(local tile (require :game.tiles))
(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:case [(string.byte "I") 0xff00]

16
wrap.fnl
View file

@ -5,8 +5,24 @@
(require :link.command)
(local core (require :core))
(local command (require :core.command))
(local common (require :core.common))
(local keymap (require :core.keymap))
(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?) {
"honeylisp:upload" (fn []