Implement font editor, text display, and custom font

asm/vm.fnl

@@ -70,6 +70,7 @@
     :ST2H :0x7d
     :RSTACK :0x6000
     :code code1
+    :nextsymid 1
     :ret (fn [self] [:jmp :next])
     :reserve (fn [self] [:block [:inx] [:inx]])
     :push
@@ -324,6 +325,18 @@
               (table.insert block :_end))))
     block)
 
+  (fn vm.gensym [self]
+    (local sym (.. "G-GEN-SYM-" self.nextsymid))
+    (set self.nextsymid (+ self.nextsymid 1))
+    sym)
+
+  (fn vm.anon [self ...]
+    (local sym (self:gensym))
+    (self.code:append sym ...)
+    [:vm :lit sym])
+
+  (fn vm.str [self str] (self:anon [:bytes str] [:db 0]))
+
   (vm:def :$dovar ; usage: [jsr :$dovar] followed by reserved space
     (vm:reserve)
     [:pla] [:sta vm.TOP :x] [:pla] [:sta vm.TOPH :x]

editor/fontedit.fnl

@@ -0,0 +1,20 @@
+(local TileView (require :editor.tileedit))
+(local tiledraw (require :editor.tiledraw))
+(local tiles (require :game.tiles))
+(local style (require :core.style))
+
+(local FontEditView (TileView:extend))
+
+(fn FontEditView.spritegen [self] tiledraw.char-to-sprite)
+(fn FontEditView.tilesize [self] (values 8 8))
+(fn FontEditView.map-bitxy [self x y] (values y x))
+(fn FontEditView.draw-tile-flags [self x y]
+  (when self.itile
+    (local char (string.char (+ self.itile 0x20 -1)))
+    (renderer.draw_text style.big_font char x y style.text))
+  (love.graphics.setColor 1 1 1 1))
+(fn FontEditView.filename [self] tiles.fn-font)
+(fn FontEditView.get_name [self] "Font Editor")
+
+FontEditView
+

editor/gfxedit.fnl

@@ -11,14 +11,14 @@
 
 (fn GraphicsEditView.new [self]
   (GraphicsEditView.super.new self)
-  (set self.tilecache (tiledraw.TileCache (self:loadgfx)))
+  (set self.tilecache (tiledraw.TileCache (tiles.loadgfx (self:filename)) (self:spritegen)))
   (set self.itile 1)
   (attach-imstate self))
-
+(fn GraphicsEditView.spritegen [self] tiledraw.tile-to-sprite)
 (fn GraphicsEditView.tilesize [self] (values 16 16))
-(fn GraphicsEditView.loadgfx [self] (tiles.loadtiles))
+(fn GraphicsEditView.filename [self] tiles.fn-tiles)
 (fn GraphicsEditView.reload [self]
-  (self.tilecache:load (self:loadgfx)))
+  (self.tilecache:load (tiles.loadgfx (self:filename))))
 
 (fn GraphicsEditView.select-rel [self ditile]
   (when self.itile

editor/init.fnl

@@ -8,17 +8,13 @@
 (local command (require :core.command))
 (local keymap (require :core.keymap))
 
-(command.add nil {
+(let [commands {}]
-  "honeylisp:tile-editor" (fn []
+  (each [_ name (ipairs [:tile :map :portrait :font])]
-    (local node (core.root_view:get_active_node))
+    (local cls (require (.. "editor." name "edit")))
-    (node:add_view (TileView)))
+    (tset commands (.. "honeylisp:" name "-editor") (fn []
-  "honeylisp:map-editor" (fn []
+      (local node (core.root_view:get_active_node))
-    (local node (core.root_view:get_active_node))
+      (node:add_view (cls)))))
-    (node:add_view (MapEditView)))
+  (command.add nil commands))
-  "honeylisp:portrait-editor" (fn []
-    (local node (core.root_view:get_active_node))
-    (node:add_view (PortraitView)))
-})
 
 (command.add (cmd-predicate :editor.gfxedit) {
   "graphics-editor:save"          (fn [] (core.active_view:save) (core.log "Saved"))

editor/portraitedit.fnl

@@ -6,12 +6,9 @@
 
 (local PortraitView (TileView:extend))
 
-(fn PortraitView.new [self]
+(fn PortraitView.spritegen [self] tiledraw.portrait-to-sprite)
-  (PortraitView.super.new self)
-  (set self.tilecache.spritegen tiledraw.portrait-to-sprite))
 (fn PortraitView.tilesize [self] (values 32 32))
-(fn PortraitView.loadgfx [self] (tiles.loadportraits))
+(fn PortraitView.filename [self] tiles.fn-portraits)
-(fn PortraitView.save [self] (tiles.saveportraits self.tilecache.tiles))
 (fn PortraitView.map-bitxy [self x y]
   (local quadrant (+ (if (>= x 16) 2 0) (if (>= y 16) 1 0)))
   (local tilex

editor/tiledraw.fnl

@@ -77,6 +77,11 @@
     (love.graphics.draw top 0 0)
     (love.graphics.draw bottom 0 16))))
 
+(fn char-to-sprite [gfx]
+  (make-canvas 7 8 (fn [canvas]
+    (for [y 0 7]
+      (draw-byte gfx (+ y 1) 0 y)))))
+
 (fn TileCache [tiles ?spritegen]
   {: tiles
    :spritegen (or ?spritegen tile-to-sprite)
@@ -101,5 +106,5 @@
        (tset self.tilesprites itile (self.spritegen (. self.tiles itile :gfx))))
      (. self.tilesprites itile))})
 
-{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : pal-from-bit : pal-from-byte : TileCache}
+{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : pal-from-bit : pal-from-byte : TileCache}
 

editor/tileedit.fnl

@@ -87,7 +87,7 @@
 (fn TileView.update-tile [self newtile]
   (self.tilecache:update-tile self.itile newtile))
 
-(fn TileView.save [self] (tiles.savetiles self.tilecache.tiles))
+(fn TileView.save [self] (tiles.savegfx (self:filename) self.tilecache.tiles))
 
 (fn TileView.draw [self]
   (self:draw_background style.background)

game/font.json

@@ -0,0 +1 @@
+[{"flags":[],"gfx":"8080808080808080"},{"flags":[],"gfx":"8C8C8C8C88808C80"},{"flags":[],"gfx":"B3B3928080808080"},{"flags":[],"gfx":"B6FFB6B6B6FFB680"},{"flags":[],"gfx":"8CBE839EB09F8C80"},{"flags":[],"gfx":"80A3938884B2B180"},{"flags":[],"gfx":"8E9B9BCEBBB3EE80"},{"flags":[],"gfx":"8C8C888080808080"},{"flags":[],"gfx":"988C8C8C8C8C9880"},{"flags":[],"gfx":"8C98989898988C80"},{"flags":[],"gfx":"8CAD9E8C9EAD8C80"},{"flags":[],"gfx":"808C8CBF8C8C8080"},{"flags":[],"gfx":"808080808C8C8880"},{"flags":[],"gfx":"8080809C80808080"},{"flags":[],"gfx":"80808080808C8C80"},{"flags":[],"gfx":"80A0B0988C868280"},{"flags":[],"gfx":"9CB6B6BEB6B69C80"},{"flags":[],"gfx":"989C989898989880"},{"flags":[],"gfx":"9CB6B0988C86BE80"},{"flags":[],"gfx":"9CB6B098B0B69C80"},{"flags":[],"gfx":"9C9E9B9BBF989880"},{"flags":[],"gfx":"BE86869EB0B09E80"},{"flags":[],"gfx":"9C86869EB6B69C80"},{"flags":[],"gfx":"BEB0B0988C8C8C80"},{"flags":[],"gfx":"9CB6B69CB6B69C80"},{"flags":[],"gfx":"9CB6B6BCB0B09C80"},{"flags":[],"gfx":"808C8C808C8C8080"},{"flags":[],"gfx":"808C8C808C8C8880"},{"flags":[],"gfx":"B0988C868C98B080"},{"flags":[],"gfx":"8080BE80BE808080"},{"flags":[],"gfx":"868C98B0988C8680"},{"flags":[],"gfx":"9CB6B0988C808C80"},{"flags":[],"gfx":"9EB3B3BBBB839E80"},{"flags":[],"gfx":"9CB6B6B6BEB6B680"},{"flags":[],"gfx":"9EB6B69EB6B69E80"},{"flags":[],"gfx":"9CB6868686B69C80"},{"flags":[],"gfx":"9EB6B6B6B6B69E80"},{"flags":[],"gfx":"BE86869E8686BE80"},{"flags":[],"gfx":"BE86869E86868680"},{"flags":[],"gfx":"9EB383BBB3B39E80"},{"flags":[],"gfx":"B6B6B6BEB6B6B680"},{"flags":[],"gfx":"8C8C8C8C8C8C8C80"},{"flags":[],"gfx":"B0B0B0B0B6BE9C80"},{"flags":[],"gfx":"B6B69E9EB6B6B680"},{"flags":[],"gfx":"868686868686BE80"},{"flags":[],"gfx":"92BFBFBFB3B3B380"},{"flags":[],"gfx":"9EB6B6B6B6B6B680"},{"flags":[],"gfx":"9CB6B6B6B6B69C80"},{"flags":[],"gfx":"9EB6B69E86868680"},{"flags":[],"gfx":"9CB6B6B6BEB6BC80"},{"flags":[],"gfx":"9EB6B69EB6B6B680"},{"flags":[],"gfx":"9CB6869CB0B69C80"},{"flags":[],"gfx":"BFBF8C8C8C8C8C80"},{"flags":[],"gfx":"B6B6B6B6B6B69C80"},{"flags":[],"gfx":"B6B6B69C9C9C8880"},{"flags":[],"gfx":"B3B3B3BFBFBF9280"},{"flags":[],"gfx":"B6B6B69CB6B6B680"},{"flags":[],"gfx":"B6B6B6BCB0B09C80"},{"flags":[],"gfx":"BEBEB0988CBEBE80"},{"flags":[],"gfx":"9C8C8C8C8C8C9C80"},{"flags":[],"gfx":"8082868C98B0A080"},{"flags":[],"gfx":"9C98989898989C80"},{"flags":[],"gfx":"8894808080808080"},{"flags":[],"gfx":"808080808080BE80"}]

game/init.fnl

@@ -7,7 +7,8 @@
 (local {: walkable} tile.flag-to-bit)
 (local prg (asm.new))
 
-(local tiles (prg:org 0x4100))
+(local tiles-org (prg:org 0x4100))
+(local font-org (prg:org 0x4900))
 (local vm (VM.new prg))
 (local code1 vm.code)
 (local mapw 20)
@@ -147,7 +148,7 @@
     :done])
 
 (vm:word :drawfooter
-  0x21d0 :clearline
+  0x39d0 :clearline
   0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
 
 (vm:word :drawmaprow ; pscreen pmap -- pmap
@@ -172,7 +173,7 @@
   ; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
   [:lda vm.TOP :x] [:tay]
   [:and 0x1f]
-  [:clc] [:adc #(hi tiles.org)]
+  [:clc] [:adc #(hi tiles-org.org)]
   [:sta vm.TOPH :x]
   [:tya] [:and 0xe0]
   [:sta vm.TOP :x])
@@ -295,7 +296,43 @@
 (vm:word :full-redraw :drawmap :object-redraw)
 (vm:word :object-redraw :jaye-yx :get :draw-jaye-yx)
 
-(tile.append-gfx tiles)
+(vm:def :draw-pchar ; pscreen pchar --
+  [:block
+    [:ldy 7] [:clc]
+  :loop
+    [:lda [vm.TOP :x]]
+    [:sta [vm.ST1 :x]]
+    [:inc vm.TOP :x]
+    [:lda vm.ST1H :x] [:adc 4] [:sta vm.ST1H :x]
+    [:dey]
+    [:bne :loop]
+  ]
+  (vm:drop) (vm:drop))
+
+(vm:def :lookup-pchar ; c -- pchar
+  [:sec]
+  [:lda vm.TOP :x]
+  [:sbc 0x20]
+  [:sta vm.TOP :x]
+  [:lda 0]
+  [:asl vm.TOP :x] [:rol :a] ;x2
+  [:asl vm.TOP :x] [:rol :a] ;x4
+  [:asl vm.TOP :x] [:rol :a] ;x8
+  [:adc #(hi font-org.org)]
+  [:sta vm.TOPH :x])
+
+(vm:word :draw-char ; pscreen c --
+  :lookup-pchar :draw-pchar)
+
+(vm:word :draw-text ; st --
+  0x2257 (vm:while [:over :bget :dup] ; st pscreen c
+    :over :swap :draw-char ; st pscreen
+    :inc :swap :inc :swap)
+  :drop :drop)
+
+(vm:word :hello-world (vm:str "HELLO, WORLD!") :draw-text)
+
+(tile.appendtiles tiles-org)
 
 ; thought:
 ; hotswap-safe debug stub at root of call stack
@@ -304,6 +341,9 @@
 ; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with?
 (tile.appendmaps (prg:org 0x4800))
 
+(font-org:append :font)
+(tile.appendgfx font-org (tile.loadgfx tile.fn-font))
+
 (code1:append :main
   [:jsr :reset]
   [:jsr :interpret]

game/portraits.json

@@ -1 +1 @@
-[{"gfx":"8080808080E0E0F0F8FC2CBCACACACAC80809CFEFFFFFFD7D5D5555D4F5DD5D5BCB8B8B8F8F8F8F8FCFCFE9E86D0D0D495D5D5E5D5D5D5D7C793D1D0AAAAAAAA808086BFFFFFFFFAEAAA2A2E3C2EAAAA80808080808183878787058F8D8D8D8FAAAAAAA7AAAAEAEAC2888A8AD5D5D5D58F8F8787878F8F8F9F9FBCB8808A8AAA","label":"pjaye","flags":[]},{"gfx":"00002020000000004808080800202028004040011404450144010805445420352020000808084800000000202000000020544405080144014504140140400000000202012921220122011021222A052D00000405000001011211101100040415052A222110012201222129010202000004040011101112010100000504000000","label":"pneut","flags":[]}]
+[{"gfx":"8080808080E0E0F0F8FC2CBCACACACAC80809CFEFFFFFFD7D5D5555D4F5DD5D5BCB8B8B8F8F8F8F8FCFCFEFE86D0D0D495D5D5E5D5D5D5D7C797D7D0AAAAAAAA808086BFFFFFFFFAEAAA2A2E3C2EAAAA80808080808183878787058F8D8D8D8FAAAAAAA7AAAAEAEAE2E8EA8AD5D5D5D58F8F8787878F8F8F9F9FBFBE808A8AAA","label":"pjaye","flags":[]},{"gfx":"00002020000000004808080800202028004040011404450144010805445420352020000808084800000000202000000020544405080144014504140140400000000202012921220122011021222A052D00000405000001011211101100040415052A222110012201222129010202000004040011101112010100000504000000","label":"pneut","flags":[]}]

game/tiles.fnl

@@ -13,21 +13,22 @@
 
 (fn serialize [tile] (doto (lume.clone tile) (tset :gfx (tile.gfx:tohex))))
 
-(fn loadtiles []      (lume.map (util.readjson "game/tiles.json") deserialize))
+(local fn-tiles "game/tiles.json")
-(fn savetiles [tiles] (util.writejson "game/tiles.json" (lume.map tiles serialize)))
+(local fn-portraits "game/portraits.json")
+(local fn-font "game/font.json")
 
-(fn loadportraits []  (lume.map (util.readjson "game/portraits.json") deserialize))
+(fn loadgfx [filename]     (lume.map (util.readjson filename) deserialize))
-(fn saveportraits [p] (util.writejson "game/portraits.json" (lume.map p serialize)))
+(fn savegfx [filename gfx] (util.writejson filename (lume.map gfx serialize)))
 
-(fn appendtiles [org tiles]
+(fn appendgfx [org gfx]
-  (each [_ tile (ipairs tiles)]
+  (each [_ g (ipairs gfx)]
-    (when tile.label (org:append tile.label))
+    (when g.label (org:append g.label))
-    (org:append [:bytes tile.gfx])))
+    (org:append [:bytes g.gfx])))
 
-(fn append-gfx [org]
+(fn appendtiles [org]
-  (local tiles (loadtiles))
+  (local tiles (loadgfx fn-tiles))
-  (appendtiles org tiles)
+  (appendgfx org tiles)
-  (appendtiles org (loadportraits))
+  (appendgfx org (loadgfx fn-portraits))
   (org:append :tileflags)
   (each [_ tile (ipairs tiles)]
     (var flags 0)
@@ -39,5 +40,6 @@
   (local map (util.readjson "game/map00001.json"))
   (org:append :map [:bytes (map.map:fromhex)]))
 
-{: loadtiles : savetiles : appendtiles : append-gfx : appendmaps : flags : flag-to-bit : loadportraits : saveportraits}
+{: loadgfx : savegfx : appendtiles : appendgfx : appendmaps : flags : flag-to-bit
+ : fn-tiles : fn-portraits : fn-font}