680 lines
32 KiB
Plaintext
680 lines
32 KiB
Plaintext
(load "Lib.kiss")
|
|
|
|
(method :Void _collectAndValidateArg [:CommandArg arg :Stream stream :Dynamic->Void continuation]
|
|
(case arg.type
|
|
(SelectedEntry
|
|
(if (= 1 _selectedEntries.length)
|
|
(continuation (first (getSelectedEntries)))
|
|
(ui.reportError "The requested command expects 1 entry to be selected. You have selected: $_selectedEntries.length")))
|
|
((SelectedEntries min max)
|
|
(unless min (set min 0))
|
|
// TODO might want to optimize this O(n) count operation by pre-calculating it
|
|
(unless max (set max (count archive.entries)))
|
|
(if !(<= min _selectedEntries.length max)
|
|
(ui.reportError "The requested command expects between $min and $max entries to be selected. You have selected: $_selectedEntries.length")
|
|
(continuation (getSelectedEntries))))
|
|
((Text maxLength)
|
|
(unless maxLength (set maxLength Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(localFunction :Void trySubmit [text]
|
|
(stream.dropWhitespace)
|
|
(if !(<= text.length maxLength)
|
|
(ui.reportError "The requested command expected a string up to $maxLength characters long. You entered: $text.length characters")
|
|
(continuation text)))
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// If no text argument was pre-supplied, use the ui for it
|
|
(ui.enterText
|
|
"${arg.name} (up to ${maxLength} characters):"
|
|
trySubmit
|
|
maxLength)
|
|
(trySubmit (readString stream))))
|
|
((VarText maxLength)
|
|
(unless maxLength (set maxLength Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(let [collectedText []]
|
|
(localFunction :Void enterTextAgain []
|
|
(localFunction :Void trySubmit [text]
|
|
(stream.dropWhitespace)
|
|
(if !text
|
|
(continuation collectedText)
|
|
(if !(<= text.length maxLength)
|
|
(ui.reportError "The requested command expected a list of strings up to $maxLength characters long. You entered: $text.length characters")
|
|
{(collectedText.push text)
|
|
(enterTextAgain)})))
|
|
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// If no vartext argument was pre-supplied, use the ui for it
|
|
(ui.enterText
|
|
"${arg.name} (up to ${maxLength} characters):"
|
|
trySubmit
|
|
maxLength)
|
|
(trySubmit (readString stream))))
|
|
(enterTextAgain)))
|
|
((or TagsFromAll TagsFromSelected)
|
|
(chooseFromTags arg.type continuation stream))
|
|
((Number min max inStepsOf)
|
|
(unless min (set min Math.NEGATIVE_INFINITY))
|
|
(unless max (set max Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(let [&mut prompt "${arg.name} (${min}-${max}"]
|
|
(when inStepsOf
|
|
(+= prompt " in steps of ${inStepsOf}"))
|
|
(+= prompt "):")
|
|
|
|
(localFunction :Void trySubmit [number]
|
|
(stream.dropWhitespace)
|
|
(let [minMaxError
|
|
"The requested command expected a number between $min and $max"
|
|
stepError
|
|
"$minMaxError in steps of $inStepsOf"
|
|
youEntered
|
|
". You entered: $number"]
|
|
(if (or
|
|
!(<= min number max)
|
|
(and inStepsOf !(= 0 (% (- number min) inStepsOf))))
|
|
(if inStepsOf
|
|
(ui.reportError "${stepError}$youEntered")
|
|
(ui.reportError "${minMaxError}$youEntered"))
|
|
(continuation number))))
|
|
|
|
// If no text argument was pre-supplied, use the ui for it
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
(ui.enterNumber
|
|
prompt
|
|
trySubmit
|
|
min
|
|
max
|
|
inStepsOf)
|
|
(trySubmit (readNumber stream)))))
|
|
((Numbers min max inStepsOf)
|
|
(unless min (set min Math.NEGATIVE_INFINITY))
|
|
(unless max (set max Math.POSITIVE_INFINITY))
|
|
(stream.dropWhitespace)
|
|
(let [&mut prompt "${arg.name} (${min}-${max}"
|
|
collectedNumbers []]
|
|
(when inStepsOf
|
|
(+= prompt " in steps of ${inStepsOf}"))
|
|
(+= prompt "):")
|
|
(localFunction :Void enterNumAgain []
|
|
(localFunction :Void trySubmit [number]
|
|
(stream.dropWhitespace)
|
|
(let [minMaxError
|
|
"The requested command expected numbers between $min and $max"
|
|
stepError
|
|
"$minMaxError in steps of $inStepsOf"
|
|
youEntered
|
|
". You entered: $number"]
|
|
(if (Math.isNaN number)
|
|
(continuation collectedNumbers)
|
|
(if (or
|
|
!(<= min number max)
|
|
(and inStepsOf !(= 0 (% (- number min) inStepsOf))))
|
|
(if inStepsOf
|
|
(ui.reportError "${stepError}$youEntered")
|
|
(ui.reportError "${minMaxError}$youEntered"))
|
|
{(collectedNumbers.push number)
|
|
(enterNumAgain)}))))
|
|
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// If no vartext argument was pre-supplied, use the ui for it
|
|
(ui.enterNumber
|
|
prompt
|
|
trySubmit
|
|
min
|
|
max
|
|
inStepsOf
|
|
true)
|
|
(trySubmit (readNumber stream))))
|
|
(enterNumAgain)))
|
|
(OneEntry
|
|
(ui.chooseEntry
|
|
"${arg.name}:"
|
|
archive
|
|
continuation))
|
|
((Entries min max)
|
|
(unless min (set min 1))
|
|
// TODO might want to optimize this O(n) count operation by pre-calculating it
|
|
(unless max (set max (count archive.entries)))
|
|
(ui.chooseEntries
|
|
"${arg.name}:"
|
|
archive
|
|
(lambda :Void [:Array<Entry> entries]
|
|
(if (or
|
|
(> min entries.length)
|
|
(< max entries.length))
|
|
|
|
(ui.reportError "The requested command expects between $min and $max entries. You chose: $entries.length")
|
|
(continuation entries)))
|
|
min
|
|
max))
|
|
(OneFile
|
|
(collectFSArgs arg.name stream false 1 1 continuation))
|
|
((Files min max)
|
|
(collectFSArgs arg.name stream false min max continuation))
|
|
(Folder
|
|
(collectFSArgs arg.name stream true 1 1 continuation))
|
|
((Folders min max)
|
|
(collectFSArgs arg.name stream true min max continuation))
|
|
(Position
|
|
(ui.choosePosition "${arg.name}:" continuation))
|
|
(never null)))
|
|
|
|
// Collect file or folder arguments using ui.chooseString
|
|
(method :Void collectFSArgs [name stream :Bool folder :Null<Float> min :Null<Float> max :Dynamic->Void continuation &opt :String cwd :Array<String> selectedPaths]
|
|
(unless min (set min 1))
|
|
(unless max (set max Math.POSITIVE_INFINITY))
|
|
(localVar rootDir (case (Sys.systemName) ("Windows" "C:/") (otherwise "/")))
|
|
(unless cwd (set cwd rootDir))
|
|
(unless selectedPaths (set selectedPaths []))
|
|
(localVar justOne (= min max 1))
|
|
(stream.dropWhitespace)
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
// Prompt for choice, keep passing an empty dummy stream to the recursive calls so they don't eat more _
|
|
(let [dummyStream (Stream.fromString "")
|
|
cwdContents (FileSystem.readDirectory cwd)
|
|
fullPathsCwdContents (for path cwdContents (joinPath cwd path))]
|
|
(doFor idx (range cwdContents.length)
|
|
(when (FileSystem.isDirectory (nth fullPathsCwdContents idx))
|
|
(+= (nth cwdContents idx) "/"))
|
|
(when (selectedPaths.contains (nth fullPathsCwdContents idx))
|
|
(set (nth cwdContents idx) "* $(nth cwdContents idx)")))
|
|
(when folder (cwdContents.unshift "CHOOSE"))
|
|
(when (>= selectedPaths.length min)
|
|
(cwdContents.unshift "SUBMIT ALL"))
|
|
(unless (= cwd rootDir)
|
|
(cwdContents.unshift "../"))
|
|
(ui.chooseBetweenStrings name cwdContents
|
|
->:Void choice
|
|
(case choice
|
|
(".."
|
|
(let [cwdParts (cwd.split "/")
|
|
_ (cwdParts.pop)
|
|
parentDir (cwdParts.join "/")]
|
|
(collectFSArgs name dummyStream folder min max continuation parentDir selectedPaths)))
|
|
("SUBMIT ALL" (continuation selectedPaths))
|
|
("CHOOSE"
|
|
(cond
|
|
(justOne (continuation cwd))
|
|
(true
|
|
(selectedPaths.push cwd)
|
|
(cond
|
|
((= selectedPaths.length max) (continuation selectedPaths))
|
|
(true (collectFSArgs name dummyStream folder min max continuation cwd selectedPaths))))))
|
|
// TODO allow de-selecting selected items (they start with "* ")
|
|
((unless (path.endsWith "/") path)
|
|
(cond
|
|
(justOne
|
|
(continuation (joinPath cwd path)))
|
|
(true
|
|
(selectedPaths.push (joinPath cwd path))
|
|
(cond
|
|
((= selectedPaths.length max) (continuation selectedPaths))
|
|
(true (collectFSArgs name dummyStream folder min max continuation cwd selectedPaths))))))
|
|
(folderPath
|
|
(collectFSArgs name dummyStream folder min max continuation (joinPath cwd folderPath) selectedPaths))
|
|
(never otherwise))))
|
|
// TODO Read the stream
|
|
(print "trying to read the stream for a filesystem argument (not implemented)! `${stream.content}`"))
|
|
)
|
|
|
|
(method :Array<String> allTags [&opt :Array<Entry> entries]
|
|
(let [:Array<Entry> 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))))
|
|
(sort (collect (tags.keys)))))
|
|
|
|
(method :Array<String> allSelectedTags []
|
|
(allTags _selectedEntries))
|
|
|
|
(method chooseFromTags [:CommandArgType type :Dynamic->Void cc :Stream stream &opt :Array<String> tagsToChooseFrom :Array<String> tagsChosen]
|
|
(let [tagsToChooseFrom
|
|
(or tagsToChooseFrom
|
|
(concat ["CONFIRM"]
|
|
(case type
|
|
(TagsFromAll (concat ["DEFINE NEW TAG"] (allTags)))
|
|
(TagsFromSelected (allSelectedTags))
|
|
(never otherwise))))
|
|
tagsChosen (or tagsChosen [])]
|
|
(withFunctions
|
|
[
|
|
(:Void checkChoice [choice]
|
|
(case choice
|
|
((or "" "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 stream tagsToChooseFrom tagsChosen)}
|
|
Math.POSITIVE_INFINITY))
|
|
(other
|
|
(tagsToChooseFrom.remove other)
|
|
(tagsChosen.push other)
|
|
(chooseFromTags type cc stream tagsToChooseFrom tagsChosen))
|
|
(never null)))
|
|
]
|
|
(stream.dropWhitespace)
|
|
// If no text argument was pre-supplied, use the ui for it
|
|
(if (or (stream.isEmpty) (stream.dropStringIf "_"))
|
|
(ui.chooseBetweenStrings
|
|
"Tags:"
|
|
tagsToChooseFrom
|
|
checkChoice)
|
|
(checkChoice (readString stream))))))
|
|
|
|
// TODO try catch and ui.reportError
|
|
// TODO maaaybe support escape sequences?
|
|
(function readString [:Stream stream]
|
|
(let [terminator
|
|
(case (stream.takeChars 1)
|
|
((Some "\"") "\"")
|
|
((Some "'") "'")
|
|
(otherwise (throw "string arg must start with \" or '")))]
|
|
(case (stream.takeUntilAndDrop terminator)
|
|
((Some s) s)
|
|
(otherwise (throw "string arg must end with $terminator")))))
|
|
|
|
// TODO try catch and ui.reportError
|
|
(function readNumber [:Stream stream]
|
|
(Std.parseFloat (case (stream.takeUntilOneOf [" "] true) ((Some f) f) (otherwise ""))))
|
|
|
|
(method :Void->Void _composeArgCollector [:Array<Dynamic> collectedArgs :CommandArg arg :Stream stream :Void->Void lastCollector]
|
|
(lambda :Void []
|
|
(_collectAndValidateArg arg stream ->:Void [:Dynamic argValue] {(collectedArgs.push argValue) (lastCollector)})))
|
|
|
|
(method :Void tryRunCommand [:String command &opt :Void->Void doAfter]
|
|
(let [parts (command.split " ")
|
|
commandName (parts.shift)
|
|
stream (Stream.fromString (parts.join " "))
|
|
lowerCommandName (commandName.toLowerCase)]
|
|
(if (commands.exists lowerCommandName)
|
|
(_runCommand (dictGet commands lowerCommandName) stream doAfter)
|
|
(ui.reportError "$commandName is not a valid command"))))
|
|
|
|
(method :Void tryRunCommands [:Array<String> commands]
|
|
(when commands
|
|
(tryRunCommand (commands.shift) ->:Void (tryRunCommands commands))))
|
|
|
|
(method :Void _runCommand [:Command command :Stream stream &opt :Void->Void doAfter]
|
|
(let [collectedArgs
|
|
[]
|
|
&mut lastCollector
|
|
(lambda []
|
|
(let [result (Reflect.callMethod null command.handler collectedArgs)]
|
|
(assert !(Prelude.isNull result) "Command implementation forgot to return a ChangeSet")
|
|
(set lastChangeSet (the ChangeSet result))
|
|
|
|
(when lastChangeSet
|
|
(doFor e lastChangeSet
|
|
(assert (and e (isEntry e)) "Lib function forgot to return the Entry that was modified"))
|
|
(doFor e lastChangeSet
|
|
(archive.refreshEntry e))
|
|
(ui.handleChanges archive lastChangeSet)
|
|
(archive.processSystems)
|
|
(when doAfter (doAfter)))))]
|
|
// To facilitate asynchronous arg input via UI, we need to construct an insanely complicated nested callback to give the UI
|
|
(doFor arg (reverse command.args)
|
|
(set lastCollector (_composeArgCollector collectedArgs arg stream lastCollector)))
|
|
(lastCollector)))
|
|
|
|
|
|
// TODO SelectedEntry and SelectedEntries functions should be stateful and use the actual
|
|
// selected entries automatically
|
|
(defMacro defCommand [name args &body body]
|
|
(let [argPairs
|
|
(groups (expList args) 2)
|
|
methodArgs
|
|
(for [name type] argPairs
|
|
(exprCase type
|
|
((exprOr SelectedEntry OneEntry) `:nat.Entry ,name)
|
|
((exprOr (SelectedEntries _ _) (Entries _ _)) `:Array<nat.Entry> ,name)
|
|
((Text _) `:String ,name)
|
|
((VarText _) `:Array<String> ,name)
|
|
(TagsFromAll `:Array<String> ,name)
|
|
(TagsFromSelected `:Array<String> ,name)
|
|
((exprOr OneFile Folder) `:String ,name)
|
|
((exprOr (Files _ _) (Folders _ _)) `:Array<String> ,name)
|
|
((Number _ _ _) `:Float ,name)
|
|
((Numbers _ _ _) `:Array<Float> ,name)
|
|
(Position `:Position ,name)))
|
|
commandArgs
|
|
(for [name type] argPairs
|
|
`(object name ,(symbolName name) type ,type))]
|
|
`{
|
|
(method ,name [,@methodArgs] ,@body)
|
|
// Preserve the capitalization of the command name for pretty help message
|
|
(commandNames.push ,(symbolName name))
|
|
// Store the command name without capitalization for forgiving call conventions
|
|
(dictSet commands ,(ReaderExp.StrExp (.toLowerCase (symbolNameValue name))) (object args [,@commandArgs] handler (the Function ,name)))
|
|
}))
|
|
|
|
(var :Array<String> commandNames [])
|
|
|
|
(method isSelected [:Entry e]
|
|
!(= -1 (_selectedEntries.indexOf e)))
|
|
|
|
(method getSelectedEntries []
|
|
(_selectedEntries.copy))
|
|
|
|
(prop &mut :PlaygroundSystem<Dynamic> playgroundSystem null)
|
|
|
|
(method :Void typeCommand []
|
|
(when ui.shortcutHandler (ui.shortcutHandler.cancel))
|
|
(ui.enterText
|
|
"Command:"
|
|
->command
|
|
(tryRunCommand command)
|
|
Math.POSITIVE_INFINITY))
|
|
|
|
// TODO typeShortcut
|
|
|
|
(defNew [&prop :Archive archive
|
|
&prop :ArchiveUI ui]
|
|
[&mut :Array<Entry> _selectedEntries []
|
|
&mut :ChangeSet lastChangeSet []
|
|
:Map<String,Command> commands (new Map)
|
|
:NameSystem nameSystem (new NameSystem)]
|
|
|
|
(set ui.controller this)
|
|
|
|
// Add systems!
|
|
(archive.addAndProcessSystem nameSystem ui)
|
|
// WikipediaImageSystem is unavailable until MediaWikiSystem can be rewritten without #extern:
|
|
(archive.addSystem (new WikipediaImageSystem))
|
|
(archive.addSystem (new ImageAttachmentSystem))
|
|
(archive.addAndProcessSystem (new KeyShortcutSystem this) ui)
|
|
(archive.addSystem (new DLSystem))
|
|
(archive.addSystem (new AutoStepperSystem))
|
|
|
|
(localFunction colorEqual [:nat.components.ColorI c1 :nat.components.ColorI c2]
|
|
(and (= c1.r c2.r) (= c1.g c2.g) (= c1.b c2.b) (= c1.a c2.a)))
|
|
(localFunction colorsContain [:Array<nat.components.ColorI> cs :nat.components.ColorI c1]
|
|
(doFor c2 cs
|
|
(when (colorEqual c2 c1)
|
|
(return true)))
|
|
(return false))
|
|
(localFunction addColorTagSystems [:Map<String,nat.components.ColorI> info]
|
|
(let [colors (collect (info.iterator))]
|
|
(doFor =>tagExp color info
|
|
(archive.addSystem (new TagSystem "ColorTagSystem{${tagExp}}" tagExp ->[archive e &opt ui]
|
|
(when (or !(hasComponent e ColorI) (colorsContain colors (readComponent e ColorI)))
|
|
(AddColorIRGBA [e] color.r color.g color.b color.a)))))))
|
|
(addColorTagSystems [
|
|
// Active: green
|
|
=>"(or active enabled)" (object r 0 g 255 b 0 a 255)
|
|
// Inactive: gray
|
|
=>"(or inactive disabled)" (object r 128 g 128 b 128 a 255)
|
|
// todo: orange
|
|
=>"todo" (object r 255 g 128 b 0 a 255)])
|
|
|
|
(whenLet [ps (ui.playgroundSystem)]
|
|
(set playgroundSystem ps)
|
|
(set ps.setupProcess true)
|
|
(archive.addAndProcessSystem ps)
|
|
(ps.switchPlaygroundKey (dictGet archive.playgrounds "default")))
|
|
|
|
(defCommand Help []
|
|
(ui.displayMessage
|
|
(+ "Available commands:\n"
|
|
(commandNames.join "\n"))) [])
|
|
|
|
(load "SelectionCommands.kiss")
|
|
|
|
(defCommand Rename [e SelectedEntry newName (Text null)]
|
|
(withWritableComponents archive e [name Name]
|
|
(set name newName))
|
|
[e])
|
|
|
|
(defCommand PrintSelectedEntries [entries (SelectedEntries 1 null)]
|
|
(doFor e entries (ui.displayMessage (archive.fullString e))) [])
|
|
|
|
(defCommand PrintComponent [entries (SelectedEntries 1 null)
|
|
componentType (Text null)]
|
|
(doFor e entries
|
|
(if (e.components.exists componentType)
|
|
(ui.displayMessage (dictGet e.components componentType))
|
|
(ui.displayMessage "Entry ${e.id} has no $componentType component"))) [])
|
|
|
|
(defCommand RemoveComponent [entries (SelectedEntries 1 null)
|
|
componentType (Text null)]
|
|
(for e entries
|
|
(withWritableEntry archive e
|
|
(e.components.remove componentType)
|
|
e)))
|
|
|
|
(defCommand CreateEntry [name (Text null)]
|
|
[(archive.createEntry ->e (addComponent archive e Name name))])
|
|
|
|
(defCommand CreateEntries [names (VarText null)]
|
|
// createEntry returns a list, so these lists must be flattened
|
|
(flatten (for name names
|
|
(CreateEntry name))))
|
|
|
|
(defCommand CreateTaggedEntry [tags TagsFromAll name (Text null)]
|
|
[(archive.createEntry ->e
|
|
{(addComponent archive e Name name)
|
|
(addTags archive e tags)})])
|
|
|
|
(defCommand CreateTaggedEntries [tags TagsFromAll names (VarText null)]
|
|
// createEntry returns a list, so these lists must be flattened
|
|
(flatten (for name names
|
|
(CreateTaggedEntry tags name))))
|
|
|
|
(defCommand CreateCircleEntry [tags (VarText null) radius (Number 0 null null)]
|
|
[(archive.createEntry ->e
|
|
{(addTags archive e tags)
|
|
(addComponent archive e Circle (objectWith radius))})])
|
|
|
|
(defCommand AddTags [entries (SelectedEntries 1 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 TagsFromSelected]
|
|
(doFor e entries
|
|
(removeTags archive e tagsToRemove))
|
|
entries) // TODO this includes entries that didn't have the tag in the changeset
|
|
|
|
(defCommand AddRectangle [entries (SelectedEntries 1 null)
|
|
width (Number 0 null null)
|
|
height (Number 0 null null)]
|
|
(doFor e entries
|
|
(addComponent archive e Rectangle (objectWith width height)))
|
|
entries)
|
|
|
|
(defCommand CreateRectangleEntry [p1 Position p2 Position]
|
|
[(archive.createEntry ->e
|
|
(let [x (min p1.x p2.x)
|
|
y (min p1.y p2.y)
|
|
w (- (max p1.x p2.x) x)
|
|
h (- (max p1.y p2.y) y)]
|
|
(addComponent archive e Positions [=>(archive.currentPlayground) (objectWith [z 0.0] x y)])
|
|
(addComponent archive e Rectangle (object width w height h))))])
|
|
|
|
(defCommand AddDLURL [e SelectedEntry url (Text null)]
|
|
[(addComponent archive e DLURL url)])
|
|
|
|
(defCommand AddYoutubeMusic [name (Text null) url (Text null)]
|
|
[(archive.createEntry ->e
|
|
{(addComponent archive e Name name)
|
|
(addTags archive e ["music"])
|
|
(AddDLURL e url)})])
|
|
|
|
(defCommand AddKeyShortcut [e SelectedEntry description (Text null)]
|
|
(addComponent archive e KeyShortcut description))
|
|
|
|
(defCommand AddNATCommand [e (SelectedEntries null null) command (Text null)]
|
|
(doFor e e (addComponent archive e NATCommand command)))
|
|
|
|
(defCommand AddNATCommands [e (SelectedEntries null null) commands (VarText null)]
|
|
(doFor e e (addComponent archive e NATCommands commands)))
|
|
|
|
(defCommand CreateShortcutEntry [description (Text null) command (Text null)]
|
|
[(archive.createEntry ->e {
|
|
(addComponent archive e Name description)
|
|
(AddKeyShortcut e description)
|
|
(AddNATCommand [e] command)})])
|
|
|
|
(defCommand CreateMultiCommandShortcut [description (Text null) commands (VarText null)]
|
|
[(archive.createEntry ->e {
|
|
(addComponent archive e Name description)
|
|
(AddKeyShortcut e description)
|
|
(AddNATCommands [e] commands)})])
|
|
|
|
(defCommand AddFiles [entries (SelectedEntries 1 null)
|
|
files (Files 1 null)]
|
|
(doFor e entries
|
|
(addFiles archive e files))
|
|
entries)
|
|
|
|
(method adjustImagePins [:Array<Entry> entries increment]
|
|
(doFor e entries
|
|
(if (hasComponent e Images2)
|
|
(withWritableComponents archive e [images Images2]
|
|
(set images.pinnedImageIndex (max 0 (min (- images.imageFiles.length 1) (+ increment images.pinnedImageIndex)))))
|
|
(ui.reportError "Entry $e has no Images2 component")))
|
|
entries)
|
|
|
|
(defCommand PinNextImage [entries (SelectedEntries 1 null)]
|
|
(adjustImagePins entries 1))
|
|
|
|
(defCommand PinPreviousImage [entries (SelectedEntries 1 null)]
|
|
(adjustImagePins entries -1))
|
|
|
|
(defCommand SetScale [entries (SelectedEntries 1 null) scale (Number 0 null null)]
|
|
(doFor e entries
|
|
(cond
|
|
((hasComponent e Images2)
|
|
(withWritableComponents archive e [i2 Images2]
|
|
(setNth i2.imageScales i2.pinnedImageIndex scale)))
|
|
((hasComponent e Scale)
|
|
(withWritableComponents archive e [scaleComponent Scale]
|
|
(set scaleComponent scale)))
|
|
(true (addComponent archive e Scale scale))))
|
|
entries)
|
|
|
|
(defCommand CreatePlayground [name (Text null) catsMatchExp (Text null) defaultTags TagsFromAll]
|
|
(archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p]
|
|
(dictSet p name (object catsMatch catsMatchExp)))
|
|
(let [[e] (CreateTaggedEntry ["playground"] name)]
|
|
(addComponent archive e CatsMatchExp catsMatchExp)
|
|
(addComponent archive e TagList defaultTags)
|
|
[e]))
|
|
|
|
(defCommand SwitchPlayground [name (Text null)]
|
|
(archive.changePlaygrounds ->:Void [:DynamicAccess<Dynamic> p] (dictSet p "default" name))
|
|
(SelectEntries [])
|
|
(when playgroundSystem (playgroundSystem.switchPlaygroundKey name))
|
|
[])
|
|
|
|
(defCommand ChoosePlayground []
|
|
(ui.chooseBetweenStrings
|
|
"Choose a playground:"
|
|
(sort (for =>key _ archive.playgrounds (if (= key "default") (continue) key)))
|
|
->pg (SwitchPlayground pg))
|
|
[])
|
|
|
|
(defCommand AddConnections [entries (SelectedEntries 1 null) entriesToConnect (Entries 1 null)]
|
|
(for e entries
|
|
(addConnections archive e entriesToConnect)))
|
|
|
|
(defCommand RemoveConnections [entries (SelectedEntries 1 null) entriesToRemove (Entries 1 null)]
|
|
(for e entries
|
|
(addConnections archive e entriesToRemove)))
|
|
|
|
(defCommand AddColorFRGBA [entries (SelectedEntries 1 null) r (Number 0 1 null) g (Number 0 1 null) b (Number 0 1 null) a (Number 0 1 null)]
|
|
(for e entries
|
|
(addColorFRGBA archive e r g b a)))
|
|
|
|
(defCommand AddColorIRGBA [entries (SelectedEntries 1 null) r (Number 0 255 1) g (Number 0 255 1) b (Number 0 255 1) a (Number 0 255 1)]
|
|
(for e entries
|
|
(addColorIRGBA archive e (Std.int r) (Std.int g) (Std.int b) (Std.int a))))
|
|
|
|
(defCommand VibeCheck [accounts (Numbers null null null) monthlyExpenses (Numbers null null null) energy (Number 1 10 1) hope (Number 1 10 1) note (Text null)]
|
|
[(archive.createEntry ->e {
|
|
(let [nw (apply + accounts)
|
|
me (apply + monthlyExpenses)
|
|
runway (/ nw me)]
|
|
(ui.displayMessage "Your net worth is \$$nw")
|
|
(if (< nw 0)
|
|
(ui.displayMessage "You are in debt and spending \$$me per month.")
|
|
(ui.displayMessage "It will last for roughly $runway months!")))
|
|
(addComponent archive e VibeCheck (objectWith [energy (Std.int energy) hope (Std.int hope)] accounts monthlyExpenses note))
|
|
(addComponent archive e Dates [=>"Created" (Date.now)])
|
|
})])
|
|
|
|
(defCommand AddEntryLink [entries (SelectedEntries 1 null) linkTo OneEntry]
|
|
(for e entries
|
|
(addEntryLink archive e linkTo)))
|
|
|
|
(defCommand InvokeEntry [e SelectedEntry]
|
|
(localFunction noInvocation []
|
|
(ui.displayMessage "tried to invoke ${e.id} but it has no available actions"))
|
|
(cond
|
|
((hasComponent e EntryLink)
|
|
(InvokeEntry (dictGet archive.entries (readComponent e EntryLink))))
|
|
((hasComponent e NATCommand)
|
|
(tryRunCommand (readComponent e NATCommand)) 0)
|
|
((hasComponent e NATCommands)
|
|
(tryRunCommands (readComponent e NATCommands)) 0)
|
|
// Switch to a playground
|
|
((catsMatch e "(and playground CatsMatchExp Name)")
|
|
(SwitchPlayground (readComponent e Name)) 0)
|
|
// Start .exe files
|
|
(e.files
|
|
(doFor file e.files
|
|
(when (file.endsWith ".exe")
|
|
(tryProcess (Path.withoutDirectory file) [] ->error (ui.displayMessage "Error launching exe ${file}: $error") null false (Path.directory file))
|
|
(return [e])))
|
|
(noInvocation) 0)
|
|
(true
|
|
(noInvocation) 0))
|
|
[e])
|
|
|
|
(defCommand TestFilePick [f OneFile]
|
|
(ui.displayMessage f)
|
|
[])
|
|
|
|
(defCommand TestFilesPick [f (Files 1 3)]
|
|
(ui.displayMessage "$f")
|
|
[])
|
|
|
|
(defCommand TestFolderPick [f Folder]
|
|
(ui.displayMessage f)
|
|
[])
|
|
|
|
(defCommand TestFoldersPick [f (Folders 1 3)]
|
|
(ui.displayMessage "$f")
|
|
[])
|
|
|
|
(defCommand ImportFolder [folder Folder]
|
|
(localVar newEntries [])
|
|
(walkDirectory "" folder
|
|
->file (archive.createEntry ->e {
|
|
(addComponent archive e Name (file.withoutDirectory))
|
|
(addFiles archive e [file] true)
|
|
(newEntries.push e)
|
|
}))
|
|
newEntries)
|
|
|
|
(defCommand OpenFiles [es (SelectedEntries 1 null)]
|
|
(doFor e es
|
|
(doFor file e.files
|
|
(localVar args [(archive.filePath file)])
|
|
(when (= (Sys.systemName) "Windows") (args.unshift ""))
|
|
(Sys.command
|
|
(case (Sys.systemName) ("Windows" "start") ("Linux" "xdg-open") ("Mac" "open") (never otherwise))
|
|
args)))
|
|
[])
|
|
|
|
(defCommand RateUp [es (SelectedEntries 1 null) reason (Text null)]
|
|
(for e es
|
|
(addUpDownRating archive e true reason)))
|
|
|
|
(defCommand RateDown [es (SelectedEntries 1 null) reason (Text null)]
|
|
(for e es
|
|
(addUpDownRating archive e false reason)))
|
|
)
|