From 397d0ead5caae7696f0b83b8af85812db5eff9dd Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Sun, 18 Dec 2022 22:58:48 +0000 Subject: [PATCH] ArchiveController support easier selection of tags --- .../src/nat/ArchiveController.hx | 6 +- .../src/nat/ArchiveController.kiss | 56 +++++++++++++++---- .../src/nat/SelectionCommands.kiss | 8 ++- 3 files changed, 56 insertions(+), 14 deletions(-) diff --git a/projects/nat-archive-tool/src/nat/ArchiveController.hx b/projects/nat-archive-tool/src/nat/ArchiveController.hx index 2035ebf6..a1f8ca65 100644 --- a/projects/nat-archive-tool/src/nat/ArchiveController.hx +++ b/projects/nat-archive-tool/src/nat/ArchiveController.hx @@ -8,6 +8,7 @@ import haxe.Constraints; import haxe.DynamicAccess; import uuid.Uuid; import nat.systems.*; +import nat.components.*; enum CommandArgType { // When called interactively, automatically pass the currently selected Entry(s) to the function @@ -24,9 +25,8 @@ enum CommandArgType { OneEntry; // This constructor must be disambiguated from the typedef "Entry" Entries(min:Null, max:Null); - // TODO Tag -- make sure a tag input is a valid haxe variable name for tagsMatch compatibility - // TODO VarTag - // What I really want is tags autocomplete, which is UNREALISTIC + TagsFromAll; + TagsFromSelected; // TODO File // TODO Files diff --git a/projects/nat-archive-tool/src/nat/ArchiveController.kiss b/projects/nat-archive-tool/src/nat/ArchiveController.kiss index f5b6d9ca..3f448587 100644 --- a/projects/nat-archive-tool/src/nat/ArchiveController.kiss +++ b/projects/nat-archive-tool/src/nat/ArchiveController.kiss @@ -50,6 +50,8 @@ maxLength) (trySubmit (readString stream)))) (enterTextAgain))) + ((or TagsFromAll TagsFromSelected) + (chooseFromTags arg.type continuation)) ((Number min max inStepsOf) (unless min (set min Math.NEGATIVE_INFINITY)) (unless max (set max Math.POSITIVE_INFINITY)) @@ -110,6 +112,43 @@ (ui.choosePosition "${arg.name}:" continuation)) (never null))) +(method :Array allTags [&opt :Array entries] + (let [:Array entries (or entries (collect (archive.entries.iterator))) + :Tags tags (new Map)] + (doFor e entries + (when (hasComponent e Tags) + (doFor =>tag _ (readComponent e Tags) + (dictSet tags tag 1)))) + (collect (tags.keys)))) + +(method :Array allSelectedTags [] + (allTags _selectedEntries)) + +(method chooseFromTags [:CommandArgType type :Dynamic->Void cc &opt tagsToChooseFrom &opt tagsChosen] + (let [tagsToChooseFrom + (or tagsToChooseFrom + (concat ["CONFIRM"] + (case type + (TagsFromAll (concat ["DEFINE NEW TAG"] (allTags))) + (TagsFromSelected (allSelectedTags)) + (never otherwise)))) + tagsChosen (or tagsChosen [])] + (ui.chooseBetweenStrings + "Tags:" + tagsToChooseFrom + ->:Void choice (case choice + ("CONFIRM" (cc tagsChosen)) + ("DEFINE NEW TAG" + (ui.enterText "New tag (must be legal as a haxe var name):" + // TODO check lowercase valid symbol etc. + ->:Void newTag {(tagsChosen.push newTag) (chooseFromTags type cc tagsToChooseFrom tagsChosen)} + Math.POSITIVE_INFINITY)) + (other + (tagsToChooseFrom.remove other) + (tagsChosen.push other) + (chooseFromTags type cc tagsToChooseFrom tagsChosen)) + (never null))))) + // TODO try catch and ui.reportError // TODO maaaybe support escape sequences? (function readString [:Stream stream] @@ -178,6 +217,8 @@ ((exprOr (SelectedEntries _ _) (Entries _ _)) `:Array ,name) ((Text _) `:String ,name) ((VarText _) `:Array ,name) + (TagsFromAll `:Array ,name) + (TagsFromSelected `:Array ,name) ((Number _ _ _) `:Float ,name) (Position `:Position ,name))) commandArgs @@ -283,14 +324,12 @@ (flatten (for name names (CreateEntry name)))) - // TODO use VarTags - (defCommand CreateTaggedEntry [tags (VarText null) name (Text null)] + (defCommand CreateTaggedEntry [tags TagsFromAll name (Text null)] [(archive.createEntry ->e {(addComponent archive e Name name) (addTags archive e tags)})]) - // TODO use VarTags - (defCommand CreateTaggedEntries [tags (VarText null) names (VarText null)] + (defCommand CreateTaggedEntries [tags TagsFromAll names (VarText null)] // createEntry returns a list, so these lists must be flattened (flatten (for name names (CreateTaggedEntry tags name)))) @@ -300,15 +339,13 @@ {(addTags archive e tags) (addComponent archive e Circle (objectWith radius))})]) - // TODO use Tag and VarTag arg types for AddTags and RemoveTags (defCommand AddTags [entries (SelectedEntries 1 null) - tagsToAdd (VarText null)] + tagsToAdd TagsFromAll] (doFor e entries (addTags archive e tagsToAdd)) entries) // TODO this includes entries that already had the tag in the changeset - (defCommand RemoveTags [entries (SelectedEntries 1 null) - tagsToRemove (VarText null)] + (defCommand RemoveTags [entries (SelectedEntries 1 null) tagsToRemove TagsFromSelected] (doFor e entries (removeTags archive e tagsToRemove)) entries) // TODO this includes entries that didn't have the tag in the changeset @@ -393,8 +430,7 @@ (true (addComponent archive e Scale scale)))) entries) - // TODO use VarTags - (defCommand CreatePlayground [name (Text null) catsMatchExp (Text null) defaultTags (VarText null)] + (defCommand CreatePlayground [name (Text null) catsMatchExp (Text null) defaultTags TagsFromAll] (archive.changePlaygrounds ->:Void [:DynamicAccess p] (dictSet p name (object catsMatch catsMatchExp))) (let [[e] (CreateTaggedEntry ["playground"] name)] diff --git a/projects/nat-archive-tool/src/nat/SelectionCommands.kiss b/projects/nat-archive-tool/src/nat/SelectionCommands.kiss index fee44794..87645178 100644 --- a/projects/nat-archive-tool/src/nat/SelectionCommands.kiss +++ b/projects/nat-archive-tool/src/nat/SelectionCommands.kiss @@ -66,7 +66,13 @@ (defSelectCommand SelectByTags [tagsBoolExp (Text null)] (filter archive.entries ->e (tagsMatch e tagsBoolExp))) - + +// variations of SelectByTags that take input from TagsFromAll, not a tagsBoolExp: +// TODO if we're being really picky these would want a variation of TagsFromAll where DEFINE NEW TAG is not an option :) +// TODO SelectByTagsAnd + +// TODO SelectByTagsOr + (defSelectCommand SelectByComponents [componentsBoolExp (Text null)] (filter archive.entries ->e (componentsMatch e componentsBoolExp)))