From f774c1aa0d855a444f015f1e5bfbd7ac6c0c638e Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Sun, 11 Sep 2022 00:05:08 +0000 Subject: [PATCH] logic for top-priority habit entries --- .../source/Entry.kiss | 5 +- .../source/HabitModel.kiss | 190 ++++++++++-------- .../source/HabitState.kiss | 2 +- 3 files changed, 113 insertions(+), 84 deletions(-) diff --git a/projects/flixel-desktop-habit-puzzle-game/source/Entry.kiss b/projects/flixel-desktop-habit-puzzle-game/source/Entry.kiss index 19e269ef..869f8323 100644 --- a/projects/flixel-desktop-habit-puzzle-game/source/Entry.kiss +++ b/projects/flixel-desktop-habit-puzzle-game/source/Entry.kiss @@ -1,8 +1,9 @@ (defNew [&prop &mut :EntryType type - &prop &mut :Array labels]) + &prop &mut :Array labels + &prop &mut :Bool topPriority]) (method toString [] - "$(case type + "$?(when topPriority "! ")$(case type ((Daily days lastDayDone) (+ (.join (for day days diff --git a/projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss b/projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss index 2dbe72b6..052c3f28 100644 --- a/projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss +++ b/projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss @@ -41,75 +41,78 @@ path (parts.join " ")] (objectWith path startingPoints puzzleWidth puzzleHeight piecesPerPoint skipped)))) ((Some line) - (.push - (case lastHeader - ("DAILY" dailyEntries) - ("MONTHLY" monthlyEntries) - ("INTERVAL" intervalEntries) - ("BONUS" bonusEntries) - ("TODO" todoEntries) - (otherwise (throw "bad header"))) - (new Entry + (let [topPriority (line.startsWith "! ")] + (when topPriority (set line (line.substr 2))) + (.push (case lastHeader - ("BONUS" Bonus) - ("TODO" Todo) - ("DAILY" - (case (line.split ":") - ([noColon] - (Daily - // all days of week - (collect (range 1 8)) - // never done before - "")) - ([::&mut preColon ...afterColon] - (set line (afterColon.join ":")) - (Daily - // Days of week specified by abbreviation: - (sort (filter - [ - // disambiguate Th from T and Su from S: - (when (contains preColon "Th") {(set preColon (StringTools.replace preColon "Th" "")) 4}) - (when (contains preColon "Su") {(set preColon (StringTools.replace preColon "Su" "")) 7}) - (when (contains preColon "M") 1) - (when (contains preColon "T") 2) - (when (contains preColon "W") 3) - (when (contains preColon "F") 5) - (when (contains preColon "S") 6) - - ])) - // Last date completed after that: - (ifLet [[days date] (preColon.split " ")] - date - ""))) - (otherwise (throw "bad line")))) - ("MONTHLY" - (case (line.split ": ") - ([::&mut preColon ...afterColon] - (set line (afterColon.join ": ")) - (Monthly - // Days of month can be positive (1-31) or negative (-1 to -31) - (map (.split (first (preColon.split " ")) ",") Std.parseInt) - // Last date completed after that: - (ifLet [[::days ...date] (preColon.split " ")] - (date.join " ") - ""))) - (otherwise (throw "bad line")))) - ("INTERVAL" - (case (line.split ": ") - ([::&mut preColon ...afterColon] - (set line (afterColon.join ": ")) - (case (preColon.split " ") - ([days] - (Interval (Std.parseInt days) "")) - ([::days ...lastDayDone] - (Interval (Std.parseInt days) (lastDayDone.join " "))) - (otherwise (throw "bad interval habit: $line")))) - (otherwise (throw "bad interval habit: $line")))) - (otherwise (throw "bad header: $lastHeader"))) - (for l (line.split "/") - (object - label (StringTools.trim (StringTools.replace l "|" "")) - points (count (l.split "") ->c (= c "|"))))))) + ("DAILY" dailyEntries) + ("MONTHLY" monthlyEntries) + ("INTERVAL" intervalEntries) + ("BONUS" bonusEntries) + ("TODO" todoEntries) + (otherwise (throw "bad header"))) + (new Entry + (case lastHeader + ("BONUS" Bonus) + ("TODO" Todo) + ("DAILY" + (case (line.split ":") + ([noColon] + (Daily + // all days of week + (collect (range 1 8)) + // never done before + "")) + ([::&mut preColon ...afterColon] + (set line (afterColon.join ":")) + (Daily + // Days of week specified by abbreviation: + (sort (filter + [ + // disambiguate Th from T and Su from S: + (when (contains preColon "Th") {(set preColon (StringTools.replace preColon "Th" "")) 4}) + (when (contains preColon "Su") {(set preColon (StringTools.replace preColon "Su" "")) 7}) + (when (contains preColon "M") 1) + (when (contains preColon "T") 2) + (when (contains preColon "W") 3) + (when (contains preColon "F") 5) + (when (contains preColon "S") 6) + + ])) + // Last date completed after that: + (ifLet [[days date] (preColon.split " ")] + date + ""))) + (otherwise (throw "bad line")))) + ("MONTHLY" + (case (line.split ": ") + ([::&mut preColon ...afterColon] + (set line (afterColon.join ": ")) + (Monthly + // Days of month can be positive (1-31) or negative (-1 to -31) + (map (.split (first (preColon.split " ")) ",") Std.parseInt) + // Last date completed after that: + (ifLet [[::days ...date] (preColon.split " ")] + (date.join " ") + ""))) + (otherwise (throw "bad line")))) + ("INTERVAL" + (case (line.split ": ") + ([::&mut preColon ...afterColon] + (set line (afterColon.join ": ")) + (case (preColon.split " ") + ([days] + (Interval (Std.parseInt days) "")) + ([::days ...lastDayDone] + (Interval (Std.parseInt days) (lastDayDone.join " "))) + (otherwise (throw "bad interval habit: $line")))) + (otherwise (throw "bad interval habit: $line")))) + (otherwise (throw "bad header: $lastHeader"))) + (for l (line.split "/") + (object + label (StringTools.trim (StringTools.replace l "|" "")) + points (count (l.split "") ->c (= c "|")))) + topPriority)))) (otherwise (break)))))) (method :Array allEntries [] @@ -166,7 +169,7 @@ (function isNotDeleted [:Entry e] !(isDeleted e)) -(function isActive [:Entry e] +(function _isActive [:Entry e] (when (isDeleted e) (return false)) (case e.type @@ -196,22 +199,47 @@ (Todo (= 0 .points (activeLabel e))) (otherwise true))) -(method :Array activeDailyEntries [] - (filter dailyEntries isActive)) +// Check if an entry is active PRE-top priority filtering +(method :Array _activeDailyEntries [] + (filter dailyEntries _isActive)) -(method :Array activeMonthlyEntries [] - (filter monthlyEntries isActive)) +(method :Array _activeMonthlyEntries [] + (filter monthlyEntries _isActive)) -(method :Array activeIntervalEntries [] - (filter intervalEntries isActive)) +(method :Array _activeIntervalEntries [] + (filter intervalEntries _isActive)) -(method :Array activeBonusEntries [] - (filter bonusEntries isActive)) +(method :Array _activeBonusEntries [] + (filter bonusEntries _isActive)) -(method :Array activeTodoEntries [] - (filter todoEntries isActive)) +(method :Array _activeTodoEntries [] + (filter todoEntries _isActive)) -(method addEntry [:EntryType type :Array labels] +(method :Array _allActiveEntries [] + (cast (concat + (_activeDailyEntries) + (_activeMonthlyEntries) + (_activeIntervalEntries) + (_activeBonusEntries) + (_activeTodoEntries)))) + +(method :Bool topPriorityIsActive [] + (apply or (for e (_allActiveEntries) e.topPriority))) + +(defMacro topPriority [name] + `(method :Array ,name [] + (let [_active (,(ReaderExp.Symbol (+ "_" (symbolNameValue name))))] + (if (topPriorityIsActive) + (filter _active ->e e.topPriority) + _active)))) + +(topPriority activeDailyEntries) +(topPriority activeMonthlyEntries) +(topPriority activeIntervalEntries) +(topPriority activeBonusEntries) +(topPriority activeTodoEntries) + +(method addEntry [:EntryType type :Array labels :Bool topPriority] (.push (case type (Todo todoEntries) (Bonus bonusEntries) @@ -219,7 +247,7 @@ ((Daily _ _) dailyEntries) ((Monthly _ _) monthlyEntries) (otherwise (throw ""))) - (new Entry type (for label labels (objectWith [points 0] label)))) + (new Entry type (for label labels (objectWith [points 0] label)) topPriority)) (save)) (method deleteEntry [:Entry e] diff --git a/projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss b/projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss index 93146f09..76daa3e2 100644 --- a/projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss +++ b/projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss @@ -837,7 +837,7 @@ (labelsAdding.push entryNameText.text)) (unless labelsAdding (return)) - (model.addEntry typeAdding labelsAdding) + (model.addEntry typeAdding labelsAdding false) // TODO allow choosing priority! (refreshModel) (entryNameText.kill) (set entryNameText null)