WIP make NAT playgrounds component-based (#124)

projects/nat-archive-tool/src/nat/ArchiveController.kiss

@@ -209,6 +209,9 @@
     (whenLet [ps (ui.playgroundSystem)]
         (set playgroundSystem ps)
         (archive.addSystem ps)
+        (set ps.setupProcess true)
+        (ps.process archive ui)
+        (set ps.setupProcess false)
         (ps.switchPlaygroundKey (dictGet archive.playgrounds "default")))
 
     // Just for testing:
@@ -338,6 +341,7 @@
     (defCommand CreatePlayground [name (Text null) catsMatchExp (Text null)]
         (archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p]
             (dictSet p name (object catsMatch catsMatchExp)))
+        // TODO make the corresponding playground entry and return it
         [])
     
     (defCommand SwitchPlayground [name (Text null)]

projects/nat-archive-tool/src/nat/components/CatsMatchExp.hx

@@ -0,0 +1,3 @@
+package nat.components;
+
+typedef CatsMatchExp = String;

projects/nat-archive-tool/src/nat/components/TagList.hx

@@ -0,0 +1,3 @@
+package nat.components;
+
+typedef TagList = Array<String>;

projects/nat-archive-tool/src/nat/systems/PlaygroundSystem.hx

@@ -3,7 +3,8 @@ package nat.systems;
 import kiss.Prelude;
 import kiss.List;
 import nat.System;
-import nat.components.Position;
+import nat.components.*;
+import haxe.DynamicAccess;
 
 typedef PlaygroundEntryProcessor = (Archive, Entry, Position, ?ArchiveUI) -> Dynamic; // Whatever value is returned will be dropped, but this is easier than requiring ->:Void
 typedef PlaygroundConnectionProcessor = (Archive, Entry, Position, Entry, Position, ?ArchiveUI) -> Dynamic; // Whatever value is returned will be dropped, but this is easier than requiring ->:Void

projects/nat-archive-tool/src/nat/systems/PlaygroundSystem.kiss

@@ -1,8 +1,12 @@
 (load "../Lib.kiss")
 
 (prop &mut :String _playgroundKey "")
+(prop &mut :TagList currentDefaultTags [])
 (method :String getPlaygroundKey [] _playgroundKey)
 
+(prop :Map<String,TagList> playgroundDefaultTags (new Map))
+(prop :Map<String,Color> playgroundBGColors (new Map))
+
 (defNew [&prop :ArchiveUI ui
             :EntryChecker canProcess
             &prop :PlaygroundEntryProcessor processor
@@ -11,28 +15,45 @@
 
     (super
         ->[archive e]
-            (and (tagsMatch e "!(or done hidden)") (canProcess archive e))
+            (or (tagsMatch e "playground")
+                (and (tagsMatch e "!(or done hidden)") (canProcess archive e)))
         ->[archive e &opt ui]
-            (when (catsMatch e .catsMatch (dictGet archive.playgrounds _playgroundKey))
-                (when !(hasComponent e Positions)
-                    (addComponent archive e Positions (new Map)))
-                (withWritableComponents archive e [positions Positions]
-                    (when !(positions.exists _playgroundKey)
-                        (dictSet positions _playgroundKey (defaultPosition e))))
-                (let [pos (dictGet (readComponent e Positions) _playgroundKey)]
-                    (processor archive e pos ui))))
+            (if setupProcess
+                    // Read playground information from playground Entries
+                    (when (catsMatch e "(and playground Name)")
+                        (let [name (readComponent e Name)]
+                            (if (hasComponent e CatsMatchExp)
+                                    (archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p] (set .catsMatch (dictGet p name) (readComponent e CatsMatchExp)))
+                                (addComponent archive e CatsMatchExp .catsMatch (dictGet archive.playgrounds name)))
+                            (dictSet playgroundBGColors name (readComponentOr e Color (object r 0.0 g 0.0 b 0.0 a 1.0)))
+                            (dictSet playgroundDefaultTags name (readComponentOr e TagList []))))
+
+                // Process Entries belonging to the current playground
+                (when (catsMatch e .catsMatch (dictGet archive.playgrounds _playgroundKey))
+                    (when !(hasComponent e Positions)
+                        (addComponent archive e Positions (new Map)))
+                    (withWritableComponents archive e [positions Positions]
+                        (when !(positions.exists _playgroundKey)
+                            (dictSet positions _playgroundKey (defaultPosition e))))
+                    (let [pos (dictGet (readComponent e Positions) _playgroundKey)]
+                        (processor archive e pos ui)))))
     (set this.onRemoveEntry onRemoveEntry))
 
 (method switchPlaygroundKey [key]
-    (when _playgroundKey
-        (clear))
     (set _playgroundKey key)
+    (clear (or (dictGet playgroundBGColors _playgroundKey) (object r 0.0 g 0.0 b 0.0 a 1.0)))
     (process ui.controller.archive ui))
 
-(method :Void clear [])
+(method :Void clear [:Color color]
+    (throw "(PlaygroundSystem.clear <color>) not implemented"))
+
+(prop &mut :Bool setupProcess false)
 
 (method &override :Void process [:Archive archive &opt :ArchiveUI ui]
     (when _playgroundKey
+        (set setupProcess true)
+        (super.process archive ui)
+        (set setupProcess false)
         (super.process archive ui)
         (doFor e (entries.iterator)
             (when (hasComponent e Positions)

projects/nat-flixel-desktop-playground/source/EntrySpriteSystem.hx

@@ -8,9 +8,8 @@ import nat.ArchiveController;
 import nat.ArchiveUI;
 import nat.Archive;
 import nat.Entry;
-import nat.components.Position;
+import nat.components.*;
 using kiss_flixel.CameraTools;
-import nat.components.Positions;
 import nat.systems.PlaygroundSystem;
 import flixel.util.FlxSort;
 

projects/nat-flixel-desktop-playground/source/EntrySpriteSystem.kiss

@@ -32,7 +32,8 @@
                 (controller.DeSelectEntry e)
             }))
 
-(method &override :Void clear []
+(method &override :Void clear [:Color color]
+    (set playState.bgColor (FlxColor.fromRGBFloat color.r color.g color.b color.a))
     (playState.debugLayer.clear)
     (sprites.clear)
     (playState.entryGroup.kill)