From dc61bb08e0558c31e15e557a3861982db08c07ff Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sat, 28 Aug 2021 22:04:54 -0400
Subject: [PATCH] iigs tile editing basically works

---
 editor/{tiledraw.fnl => tiledraw/ii.fnl} | 52 ++---------------------
 editor/tiledraw/iigs.fnl                 | 21 ++++++++++
 editor/tiledraw/init.fnl                 | 53 ++++++++++++++++++++++++
 editor/tileedit/ii.fnl                   |  1 +
 editor/tileedit/iigs.fnl                 | 12 ++++++
 editor/tileedit/init.fnl                 | 32 +++++++++++---
 game/files.fnl                           | 13 ++++--
 neutgs/game.json                         |  1 +
 8 files changed, 128 insertions(+), 57 deletions(-)
 rename editor/{tiledraw.fnl => tiledraw/ii.fnl} (62%)
 create mode 100644 editor/tiledraw/iigs.fnl
 create mode 100644 editor/tiledraw/init.fnl
 create mode 100644 editor/tileedit/iigs.fnl
 create mode 100644 neutgs/game.json

diff --git a/editor/tiledraw.fnl b/editor/tiledraw/ii.fnl
similarity index 62%
rename from editor/tiledraw.fnl
rename to editor/tiledraw/ii.fnl
index d888ee0..4e95ebe 100644
--- a/editor/tiledraw.fnl
+++ b/editor/tiledraw/ii.fnl
@@ -1,3 +1,5 @@
+(local {: putpixel : make-canvas} (require :editor.tiledraw))
+
 (fn pal-from-bit [bit]
   (if bit
     (values [20 207 253] [255 106 60])
@@ -6,25 +8,6 @@
 (fn pal-from-byte [byte]
   (pal-from-bit (not= 0 (bit.band byte 0x80))))
 
-(fn putpixel [x y color]
-  (when color
-    (love.graphics.setColor (/ (. color 1) 255) (/ (. color 2) 255) (/ (. color 3) 255))
-    (love.graphics.points (+ x 0.5) (+ y 0.5))))
-
-(fn make-canvas [w h f]
-  (local canvas (love.graphics.newCanvas w h))
-  (local prevcanvas (love.graphics.getCanvas))
-  (canvas:setFilter :nearest :nearest)
-  (local scissor [(love.graphics.getScissor)])
-  (love.graphics.setScissor)
-  (love.graphics.setCanvas canvas)
-  (love.graphics.clear 0 0 0)
-  (f canvas)
-  (love.graphics.setCanvas prevcanvas)
-  (love.graphics.setScissor (table.unpack scissor))
-  (love.graphics.setColor 1 1 1 1)
-  canvas)
-
 (fn draw-byte [bytes ibyte xoffset y ?state ?prevpal]
   (local byte (string.byte (bytes:sub ibyte ibyte)))
   (var prevstate nil)
@@ -105,32 +88,5 @@
       (for [y 0 7]
         (draw-byte gfx (+ y 1) 0 y))))))
 
-(fn TileCache [tiles ?spritegen]
-  {: tiles
-   :spritegen (or ?spritegen tile-to-sprite)
-   :tilesprites []
-   :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
-   :cachekey (fn [itile ?key] (.. (or ?key :gfx) itile))
-   :update-tile
-   (fn [self itile tile ?key]
-     (tset self.tiles itile
-       (-> (self:tile itile)
-         (doto (tset (or ?key :gfx) tile))))
-     (tset self.tilesprites (self.cachekey itile ?key) nil))
-   :set-flag
-   (fn [self itile flag clear]
-     (tset (. self.tiles itile :flags) flag (if clear nil true)))
-   :load
-   (fn [self tiles]
-     (set self.tiles tiles)
-     (set self.tilesprites []))
-   :sprite
-   (fn [self itile ?key]
-     (local key (self.cachekey itile ?key))
-     (when (and (= nil (. self.tilesprites key)) (not= nil (. self.tiles itile)))
-       (tset self.tilesprites key (self.spritegen (. self.tiles itile (or ?key :gfx)))))
-     (. self.tilesprites key))})
-
-{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : scanline-to-sprite
- : screen-y-to-offset : pal-from-bit : pal-from-byte : TileCache : make-canvas : draw-byte}
-
+{: tile-to-sprite : char-to-sprite : portrait-to-sprite : screen-to-sprite : scanline-to-sprite : screen-y-to-offset
+ : tilestrip-to-sprite : pal-from-bit : pal-from-byte : draw-byte}
diff --git a/editor/tiledraw/iigs.fnl b/editor/tiledraw/iigs.fnl
new file mode 100644
index 0000000..1b249ef
--- /dev/null
+++ b/editor/tiledraw/iigs.fnl
@@ -0,0 +1,21 @@
+(local {: putpixel : make-canvas} (require :editor.tiledraw))
+
+; converted from http://pixeljoint.com/forum/forum_posts.asp?TID=12795 (db16)
+; maybe check out https://lospec.com/palette-list ?
+(local pal [[1 0 1]  [4 2 3]  [3 3 6]  [4 4 4]  [8 4 3]   [3 6 2]   [13 4 4]  [7 7 6]
+            [5 7 12] [13 7 2] [8 9 10] [6 10 2] [13 10 9] [6 12 12] [13 13 5] [13 14 13]])
+(fn gs-to-rgb [color] (icollect [_ v (ipairs color)] (* v 0x11)))
+
+(fn tile-to-sprite [tile]
+  (if tile (make-canvas 16 16 (fn [canvas]
+    (for [y 0 15]
+      (for [x 0 15 2]
+        (let [ibyte (+ (* y 8) (math.floor (/ x 2)) 1)
+              byte (string.byte (tile:sub ibyte ibyte))
+              _ (print x y ibyte byte)
+              left (bit.band (bit.rshift byte 4) 0xf)
+              right (bit.band byte 0xf)]
+          (putpixel x y (gs-to-rgb (. pal (+ left 1))))
+          (putpixel (+ x 1) y (gs-to-rgb (. pal (+ right 1)))))))))))
+
+{: tile-to-sprite : pal : gs-to-rgb}
diff --git a/editor/tiledraw/init.fnl b/editor/tiledraw/init.fnl
new file mode 100644
index 0000000..c25618e
--- /dev/null
+++ b/editor/tiledraw/init.fnl
@@ -0,0 +1,53 @@
+(local files (require :game.files))
+(local TileDraw {})
+
+(fn TileDraw.putpixel [x y color]
+  (when color
+    (love.graphics.setColor (/ (. color 1) 255) (/ (. color 2) 255) (/ (. color 3) 255))
+    (love.graphics.points (+ x 0.5) (+ y 0.5))))
+
+(fn TileDraw.make-canvas [w h f]
+  (local canvas (love.graphics.newCanvas w h))
+  (local prevcanvas (love.graphics.getCanvas))
+  (canvas:setFilter :nearest :nearest)
+  (local scissor [(love.graphics.getScissor)])
+  (love.graphics.setScissor)
+  (love.graphics.setCanvas canvas)
+  (love.graphics.clear 0 0 0)
+  (f canvas)
+  (love.graphics.setCanvas prevcanvas)
+  (love.graphics.setScissor (table.unpack scissor))
+  (love.graphics.setColor 1 1 1 1)
+  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
+  :pal-from-bit :pal-from-byte :draw-byte)
+
+(fn TileDraw.TileCache [tiles ?spritegen]
+  {: tiles
+   :spritegen (or ?spritegen TileDraw.tile-to-sprite)
+   :tilesprites []
+   :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
+   :cachekey (fn [itile ?key] (.. (or ?key :gfx) itile))
+   :update-tile
+   (fn [self itile tile ?key]
+     (tset self.tiles itile
+       (-> (self:tile itile)
+         (doto (tset (or ?key :gfx) tile))))
+     (tset self.tilesprites (self.cachekey itile ?key) nil))
+   :set-flag
+   (fn [self itile flag clear]
+     (tset (. self.tiles itile :flags) flag (if clear nil true)))
+   :load
+   (fn [self tiles]
+     (set self.tiles tiles)
+     (set self.tilesprites []))
+   :sprite
+   (fn [self itile ?key]
+     (local key (self.cachekey itile ?key))
+     (when (and (= nil (. self.tilesprites key)) (not= nil (. self.tiles itile)))
+       (tset self.tilesprites key (self.spritegen (. self.tiles itile (or ?key :gfx)))))
+     (. self.tilesprites key))})
+
+TileDraw
diff --git a/editor/tileedit/ii.fnl b/editor/tileedit/ii.fnl
index 5056e5f..be096df 100644
--- a/editor/tileedit/ii.fnl
+++ b/editor/tileedit/ii.fnl
@@ -15,5 +15,6 @@
  :draw-off  (fn [self]   (set self.bit nil))
  :draw-on   (fn [self b] (when (= self.bit nil) (set self.bit (if (= b 1) 0 1))))
  :draw-bits (fn [self] self.bit)
+ :pixel-storage-divisor #8
 }
 
diff --git a/editor/tileedit/iigs.fnl b/editor/tileedit/iigs.fnl
new file mode 100644
index 0000000..121dc48
--- /dev/null
+++ b/editor/tileedit/iigs.fnl
@@ -0,0 +1,12 @@
+(local {: pal : gs-to-rgb} (require :editor.tiledraw.iigs))
+
+{:map-bitxy (fn [self x y]
+  (let [ibyte (+ (* y 8) (bit.rshift x 1))
+        ibit (match (% x 2) 0 4 1 0)]
+    (values ibyte ibit 0x0f)))
+ :pixel-color (fn [self b] (gs-to-rgb (. pal (+ b 1))))
+ :draw-bits #(- $1.icolor 1)
+ :palette #(icollect [_ color (ipairs pal)] (gs-to-rgb color))
+ :pixel-storage-divisor #2
+}
+
diff --git a/editor/tileedit/init.fnl b/editor/tileedit/init.fnl
index b46c45e..3192f1b 100644
--- a/editor/tileedit/init.fnl
+++ b/editor/tileedit/init.fnl
@@ -3,7 +3,7 @@
 (local tiles (require :game.tiles))
 (local files (require :game.files))
 (local util (require :lib.util))
-(local {: mouse-inside : activate : active? : checkbox : textfield} (util.require :editor.imstate))
+(local {: mouse-inside : activate : active? : checkbox : textfield : button} (util.require :editor.imstate))
 
 (local TileView (GraphicsEditView:extend))
 
@@ -16,7 +16,7 @@
     [:gfx]))
 
 (fn get-byte [tile ibyte]
-  (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte))
+  (or (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte) 0))
 (fn get-bits [tile ibyte ibit mask]
   (-> (get-byte tile ibyte)
       (bit.band (bit.lshift mask ibit))
@@ -30,11 +30,13 @@
 (fn set-tile-bits [tile ibyte ibit mask bits]
   (util.splice tile ibyte (string.char (set-bits tile ibyte ibit mask bits))))
 
+(files.platform-methods TileView :editor.tileedit :map-bitxy :pixel-color :draw-on :draw-off :draw-bits
+  :palette :pixel-storage-divisor)
+
 (fn TileView.tile [self]
   (local (w h) (self:tilesize))
-  (or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx))) (string.rep "\0" (/ (* w h) 8))))
-
-(files.platform-methods TileView :editor.tileedit :map-bitxy :pixel-color :draw-on :draw-off :draw-bits)
+  (or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx)))
+      (string.rep "\0" (/ (* w h) (self:pixel-storage-divisor)))))
 
 (fn TileView.draw-pixel [self x y colorbg ?colorfg]
   (renderer.draw_rect x y pixel-size pixel-size colorbg)
@@ -76,6 +78,25 @@
   (each [iflag flagname (ipairs (tiles.flags))]
     (set y (self:draw-tile-flag flagname x (+ y style.padding.y)))))
 
+(fn TileView.draw-tile-palette [self x y w]
+  (local pal (self:palette))
+  (if pal
+    (do (var cx x)
+        (var cy y)
+        (each [icolor color (ipairs pal)]
+          (when (>= cx w)
+            (set cx x)
+            (set cy (+ cy pixel-size style.padding.y)))
+          (when (button self [:pal icolor] cx cy pixel-size pixel-size)
+            (set self.icolor icolor))
+          (renderer.draw_rect cx cy pixel-size pixel-size color)
+          (when (= icolor self.icolor)
+            (love.graphics.setColor 1 1 1 1)
+            (love.graphics.rectangle :line (- cx 2) (- cy 2) (+ pixel-size 4) (+ pixel-size 4)))
+          (set cx (+ cx pixel-size style.padding.x)))
+        (+ pixel-size style.padding.y))
+    0))
+
 (fn TileView.update-tile [self newtile]
   (self.tilecache:update-tile self.itile newtile self.tilekey))
 
@@ -87,6 +108,7 @@
   (local (editor-w editor-h) (self:draw-tile-editor (self:tile) x y))
   (self:draw-tile-flags (+ x editor-w pixel-size) y)
   (var selector-y (+ y editor-h pixel-size))
+  (set selector-y (+ selector-y (self:draw-tile-palette x selector-y (- self.size.x 20))))
   (each [_ key (ipairs (self:tilekeys))]
     (local selector-h (self:draw-tile-selector x selector-y (- self.size.x 20) key))
     (set selector-y (+ selector-y selector-h pixel-size)))
diff --git a/game/files.fnl b/game/files.fnl
index 80ad427..1ea7994 100644
--- a/game/files.fnl
+++ b/game/files.fnl
@@ -1,6 +1,5 @@
 (local util (require :lib.util))
 (local lume (require :lib.lume))
-(local tiledraw (require :editor.tiledraw))
 
 (local files (util.hot-table ...))
 
@@ -51,7 +50,8 @@
        (if (util.file-exists (filename))
          (let [game (util.readjson (filename))]
            (each [k v (pairs game)]
-             (tset game k (lume.map v #(deserialize k (clone $1) game))))
+             (when (= (type v) :table)
+               (tset game k (lume.map v #(deserialize k (clone $1) game)))))
            game)
          {:tiles [] :portraits [] :font [] :levels []}))
   files.game)
@@ -64,15 +64,19 @@
     (util.writejson (filename) game)))
 
 (fn new-cache [game key]
-  (let [spritegen (match key
+  (let [tiledraw (require :editor.tiledraw)
+        spritegen (match key
                          :font tiledraw.char-to-sprite
                          :brushes tiledraw.char-to-sprite
                          :portraits tiledraw.portrait-to-sprite
                          _ tiledraw.tile-to-sprite)
         gfx (. game key)]
+    (print gfx key)
     (tiledraw.TileCache gfx spritegen)))
 
 (fn files.cache [key]
+  (when (= (. files.game key) nil)
+    (tset files.game key []))
   (when (= (?. files :tilecaches key) nil)
     (util.nested-tset files [:tilecaches key] (new-cache files.game key)))
   (. files.tilecaches key))
@@ -89,7 +93,8 @@
 (fn files.platform [] (or files.game.platform :ii))
 (fn files.platform-methods [cls module-prefix ...]
   (each [_ key (ipairs [...])]
-    (tset cls key (fn [...] ((. (require (.. module-prefix :. (files.platform))) key) ...)))))
+    (tset cls key (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) key)]
+                              (when f (f ...)))))))
 
 (when (= files.game nil)
   (files.load))
diff --git a/neutgs/game.json b/neutgs/game.json
new file mode 100644
index 0000000..6242fa7
--- /dev/null
+++ b/neutgs/game.json
@@ -0,0 +1 @@
+{"platform": "iigs"}