Honeylisp project support, porting Neut Tower

bitsy/player.fnl

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

editor/init.fnl

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

editor/mapedit.fnl

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

editor/tileedit.fnl

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

game/files.fnl

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

game/tiles.fnl

@@ -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 {})
+(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]
   (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]

neuttower/defs.fnl

@@ -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 files.game.tiles label))
-(fn itile [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 : tilelist : controlstate}
+{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : controlstate}
 

neuttower/init.fnl

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

neuttower/level1.fnl

@@ -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")
+(let [map (. files.game.levels 1)
-      maptiles (map.map:fromhex)
+      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]

neuttower/level2.fnl

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

neuttower/level3.fnl

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

neuttower/level4.fnl

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

neuttower/level5.fnl

@@ -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 {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
-(local level (deflevel "game/map5.json" :level5))
+(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)

neuttower/level6.fnl

@@ -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 {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
-(local level (deflevel "game/map6.json" :level6))
+(local level (deflevel 6 :level6))
 (local vm level.vm)
 
 (vm:word :linkloop ; e -- e

neuttower/player.fnl

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

wrap.fnl

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