I'm drawing lots of tiles!! also support locals in inline asm

editor/gfxedit.fnl

@@ -20,7 +20,6 @@
 (fn GraphicsEditView.get_scrollable_size [self] self.scrollheight)
 (fn GraphicsEditView.resource-key [self] :tiles)
 (fn GraphicsEditView.tilesize [self] (values 16 16))
-(fn GraphicsEditView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) 8)))
 (fn GraphicsEditView.reload [self] (files.reload))
 (fn GraphicsEditView.save [self] (files.save))
 
@@ -36,7 +35,7 @@
   (var tilex x)
   (var tiley y)
   (var (pixw pixh) (self:tilesize))
-  (set pixw (* (/ pixw 8) 7))
+  (when (= files.game.platform :ii) (set pixw (* (/ pixw 8) 7)))
   (local tilew (* self.sprite-scale pixw))
   (local tileh (* self.sprite-scale pixh))
   (for [itile 1 (length self.tilecache.tiles)]

editor/mapedit.fnl

@@ -10,10 +10,16 @@
 
 (local MapEditView (GraphicsEditView:extend))
 (local sprite-scale 3)
-(local mapw 20)
+
-(local maph 12)
+(local platforms {
-(local tilew (* sprite-scale 14))
+  :ii   {:mapw 20 :maph 12 :tilew 14 :tileh 16}
-(local tileh (* sprite-scale 16))
+  :iigs {:mapw 20 :maph 12 :tilew 16 :tileh 16}
+})
+
+(local platform (. platforms (files.platform)))
+(local {: mapw : maph} platform)
+(local tilew (* sprite-scale platform.tilew))
+(local tileh (* sprite-scale platform.tileh))
 
 (fn MapEditView.new [self]
   (MapEditView.super.new self)
@@ -60,10 +66,15 @@
   (when (. objects (+ iobjectsrc 1))
     (move-object objects (+ iobjectsrc 1) iobjectsrc)))
 
+(fn MapEditView.levels [self]
+  (when (= files.game.levels nil)
+    (set files.game.levels []))
+  files.game.levels)
+
 (fn MapEditView.draw-map-selector [self x y]
   (renderer.draw_text style.font "Map" x (+ y (/ style.padding.y 2)) style.text)
   (let [options {}
-        level-count (length files.game.levels)
+        level-count (length (self:levels))
         _ (do (for [i 1 level-count] (tset options i i))
               (table.insert options :New))
         (ilevel yNext) (dropdown self :map-selector self.ilevel options (+ x (* 50 SCALE)) y (* 100 SCALE))]
@@ -222,9 +233,9 @@
 
 (fn MapEditView.load-level [self]
   (set self.stripcache {})
-  (when (= (. files.game.levels self.ilevel) nil)
+  (when (= (. (self:levels) self.ilevel) nil)
-    (tset files.game.levels self.ilevel {:map (string.rep "\0" (* mapw maph)) :objects []}))
+    (tset (self:levels) self.ilevel {:map (string.rep "\0" (* mapw maph)) :objects []}))
-  (set self.level (. files.game.levels self.ilevel))
+  (set self.level (. (self:levels) self.ilevel))
   (set self.iobject nil))
 
 (fn MapEditView.reload [self]

editor/tiledraw/init.fnl

@@ -21,9 +21,16 @@
   canvas)
 
 (files.platform-methods TileDraw :editor.tiledraw
-  :tile-to-sprite :char-to-sprite :portrait-to-sprite :screen-to-sprite :screen-y-to-offset :tilestrip-to-sprite
+  :tile-to-sprite :char-to-sprite :portrait-to-sprite :screen-to-sprite :screen-y-to-offset
   :pal-from-bit :pal-from-byte :draw-byte)
 
+(files.default-platform-method TileDraw :editor.tiledraw :tilestrip-to-sprite
+  (fn [tiles]
+    (let [sprites (icollect [_ tile (ipairs tiles)] (TileDraw.tile-to-sprite tile))]
+      (TileDraw.make-canvas (* (: (. sprites 1) :getWidth) (length sprites)) (: (. sprites 1) :getHeight)
+        #(each [isprite sprite (ipairs sprites)]
+          (love.graphics.draw sprite (* (sprite:getWidth) (- isprite 1)) 0))))))
+
 (fn TileDraw.TileCache [tiles ?spritegen]
   {: tiles
    :spritegen (or ?spritegen TileDraw.tile-to-sprite)

editor/tileedit/init.fnl

@@ -14,6 +14,7 @@
 (fn TileView.tilekeys [self]
   (if files.game.tilesets (icollect [_ key (pairs files.game.tilesets)] key)
     [:gfx]))
+(fn TileView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) (self:pixel-storage-divisor))))
 
 (fn get-byte [tile ibyte]
   (or (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte) 0))

game/files.fnl

@@ -90,10 +90,10 @@
   (or files.game.module (: (filename) :match "^[^/]+")))
 
 (fn files.platform [] (or files.game.platform :ii))
+(fn files.default-platform-method [cls module-prefix method default]
+  (tset cls method (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) method)] (if f (f ...) (default ...))))))
 (fn files.platform-methods [cls module-prefix ...]
-  (each [_ key (ipairs [...])]
+  (each [_ key (ipairs [...])] (files.default-platform-method cls module-prefix key #nil)))
-    (tset cls key (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) key)]
-                              (when f (f ...)))))))
 
 (when (= files.game nil)
   (files.load))

neutgs/game.json

@@ -1 +1 @@
-{"platform":"iigs","tiles":[{"flags":[],"word":"","label":"","gfx":"FFFFFFFFFFFFFFFFFAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3F3333333F3333333FFFFFFFFFFFFFFFFFAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3F3333333F3333333"}]}
+{"tiles":[{"flags":[],"word":"","label":"","gfx":"77777777777777777FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF1711111117111111177777777777777777FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17111111171111111"},{"flags":[],"word":"","label":"","gfx":"7777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777799999999999999999999999999999999"},{"flags":[],"word":"","label":"","gfx":"7777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777"}],"platform":"iigs","levels":[{"loadword":"","objects":[],"tickword":"","moveword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"}]}

neutgs/init.fnl

@@ -47,15 +47,17 @@
       (lume.concat [:block] (table.unpack writes))))])
 
   (fn draw-tile (tile (long addr))
-    (let (y 0)
+    (asm
-      (while (< y 16)
+      (lda addr)   (sta [ssc.ADDR_LO])
-        (word! addr (word-at tile))
+      (lda addr 2) (sta [ssc.ADDR_HI])
-        (word! (+ addr 2) (word-at (+ tile 2)))
+      (ldy 0) (ldx 16) (clc)
-        (word! (+ addr 4) (word-at (+ tile 4)))
+    loop
-        (word! (+ addr 6) (word-at (+ tile 6)))
+      (lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
-        (set! addr (+ addr 160))
+      (lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
-        (set! tile (+ tile 8))
+      (lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
-        (set! y (+ y 1)))))
+      (lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
+      (lda [ssc.ADDR_LO]) (adc 152) (sta [ssc.ADDR_LO])
+      (dex) (bne loop)))
 
   (global word userID)
 
@@ -65,6 +67,17 @@
       (yield)
       (set! i (+ i 1)))))
 
+  (fn draw-test-tiles ()
+    (let (x 0 y 0 screen screen-addr)
+      (while (< y 12)
+        (draw-tile (ref tiles) screen)
+        (set! x (+ x 1))
+        (if (= x 20)
+          (do (set! x 0)
+              (set! y (+ y 1))
+              (set! screen (+ screen [(+ 8 (* 160 15))])))
+          (set! screen (+ screen 8))))))
+
   (fn main ()
     (LoadTools (far-ref toolsets))
     (set! userID (MMStartUp))
@@ -76,7 +89,8 @@
 
     (set-palette 0 [pal])
     (SetAllSCBs 0)
-    (draw-tile (ref tiles) screen-addr)
+
+    (draw-test-tiles)
     (wait-for-key)
 
     (GrafOff)

ssc/init.fnl

@@ -69,9 +69,11 @@
                    opgen.hi :long
                 :word)
         c-setup (when opgen.setup (opgen.setup))
-        c-lo [(opgen.lo :lda) [:pha]]
+        c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])
-        c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])]
+        loc {: name :type :word}
-    (table.insert self.locals {: name :type etype})
+        _ (table.insert self.locals loc)
+        c-lo [(opgen.lo :lda) [:pha]]]
+    (set loc.type etype)
     (lume.concat [:block c-setup] c-hi c-lo)))
 
 (fn Ssc.remove-local [self ?name]
@@ -194,8 +196,16 @@
   (set self.locals [])
   {:arity (length args) :args arglocals :org self.org :type etype : name})
 
+(fn Ssc.asm-localify [self block]
+  (icollect [_ inst (ipairs block)]
+    (match inst
+      (where [op loc ?off]      (self:local-offset loc)) [op (+ (self:local-offset loc) (or ?off 0)) :s]
+      (where [op [loc ?off] :y] (self:local-offset loc)) [op [(+ (self:local-offset loc) (or ?off 0)) :s] :y]
+      [:block]                                           (self:asm-localify inst)
+      _                                                  inst)))
+
 (set Ssc.forms
-  {:asm (fn [self ...] (if (self:defining?) [:block ...] (self.org:append ...)))
+  {:asm (fn [self ...] (if (self:defining?) (self:asm-localify [:block ...]) (self.org:append (table.unpack (self:asm-localify [...])))))
    :asm-long (fn [self ...] (values [:block ...] :long))
    :org (lambda [self org] (set self.org (self.prg:org org)))
    :start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol))

wrap.fnl

@@ -25,6 +25,14 @@
             (table.insert files item.filename)))
         (common.fuzzy_match files text))))})
 
+(fn selected-symbol []
+  (local ldoc core.active_view.doc)
+  (var (aline acol bline bcol) (ldoc:get_selection))
+  (when (and (= aline bline) (= acol bcol))
+    (set (aline acol) (translate.start_of_word ldoc aline acol))
+    (set (bline bcol) (translate.end_of_word ldoc bline bcol)))
+  (ldoc:get_text aline acol bline bcol))
+
 (command.add #(link.machine:connected?) {
   "honeylisp:upload" (fn []
     (local p (util.reload "game"))
@@ -50,18 +58,20 @@
     (editor.inline-eval vm-eval))
 })
 
+(command.add #(and (link.machine:connected?) link.machine.set-bp) {
+  "honeylisp:set-breakpoint" (fn []
+    (local word (selected-symbol))
+    (local p (require "game"))
+    (local addr (p:lookup-addr word))
+    (if addr (do (link.machine:set-bp addr)
+                 (core.log (.. "Set breakpoint at " addr)))
+      (core.log (.. "Unknown address for " word))))
+})
+
 (command.add (fn [] true) {
   "honeylisp:rebuild" #(util.reload "game")
 })
 
-(fn selected-symbol []
-  (local ldoc core.active_view.doc)
-  (var (aline acol bline bcol) (ldoc:get_selection))
-  (when (and (= aline bline) (= acol bcol))
-    (set (aline acol) (translate.start_of_word ldoc aline acol))
-    (set (bline bcol) (translate.end_of_word ldoc bline bcol)))
-  (ldoc:get_text aline acol bline bcol))
-
 (command.add "core.docview" {
   "fennel:eval" #(editor.inline-eval #(fv (fennel.eval $1 {:env _G :compiler-env _G}) {}))
   "lume:hotswap" (fn []
@@ -85,6 +95,7 @@
   "alt+v" "honeylisp:vm-eval"
   "alt+r" "lume:hotswap"
   "alt+a" "honeylisp:address"
+  "alt+b" "honeylisp:set-breakpoint"
   "alt+l" "honeylisp:reload"
 })