Files
kiss-vscode/projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss
2022-06-18 20:35:57 +00:00

207 lines
11 KiB
Plaintext

(prop :Array<Entry> dailyEntries [])
(prop :Array<Entry> monthlyEntries [])
(prop :Array<Entry> intervalEntries [])
(prop :Array<Entry> bonusEntries [])
(prop :Array<Entry> todoEntries [])
(prop :Array<RewardFile> rewardFiles [])
(defNew [&prop :String textFile]
(let [s (Stream.fromFile textFile)
&mut lastHeader ""]
// TODO could be whileLet
(loop
(case (s.takeLine)
((Some "DAILY")
(set lastHeader "DAILY"))
((Some "MONTHLY")
(set lastHeader "MONTHLY"))
((Some "INTERVAL")
(set lastHeader "INTERVAL"))
((Some "BONUS")
(set lastHeader "BONUS"))
((Some "TODO")
(set lastHeader "TODO"))
((Some "FILES")
(set lastHeader "FILES"))
((when (apply = (concat ["-"] (line.split ""))) (Some line))
(continue))
((Some "") (continue))
// Types won't unify with the next case, so this is its own:
((when (= lastHeader "FILES") (Some line))
(rewardFiles.push
(let [parts (line.split " ")
startingPoints (Std.parseInt (parts.pop))
path (parts.join " ")]
(objectWith path startingPoints))))
((Some line)
(.push
(case lastHeader
("DAILY" dailyEntries)
("MONTHLY" monthlyEntries)
("INTERVAL" intervalEntries)
("BONUS" bonusEntries)
("TODO" todoEntries)
(otherwise (throw "bad header")))
(object
type
(case lastHeader
("BONUS" Bonus)
("TODO" Todo)
("DAILY"
(case (line.split ":")
([noColon]
(Daily
// all days of week
(collect (range 7))
// 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" "")) 0})
(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")))
labels
(for l (line.split "/")
(object
label (StringTools.trim (StringTools.replace l "|" ""))
points (count (l.split "") ->c (= c "|")))))))
(otherwise (break))))))
(method :Array<Entry> allEntries []
(cast (concat dailyEntries monthlyEntries intervalEntries bonusEntries todoEntries)))
(method :Int totalPoints []
(apply + (for l (flatten (for e (allEntries) e.labels)) l.points)))
(function :String stringify [:Entry e]
"$(case e.type
((Daily days lastDayDone)
(+
(.join (for day days
(case day
(0 "Su")
(1 "M")
(2 "T")
(3 "W")
(4 "Th")
(5 "F")
(6 "S")
(otherwise (throw "bad day")))) "")
" "
lastDayDone
": "))
((Monthly days lastDayDone)
"$(days.join ",") ${lastDayDone}: ")
((Interval days lastDayDone)
"$days ${lastDayDone}: ")
(otherwise ""))$(.join (for label e.labels
"${label.label} $(* "|" label.points)") "/")")
(function :String stringifyRewardFile [:RewardFile rewardFile]
"${rewardFile.path} ${rewardFile.startingPoints}")
(method :Void save []
(localVar &mut content "DAILY\n-----\n")
(+= content (.join (map dailyEntries stringify) "\n") "\n")
(+= content "\nMONTHLY\n--------\n")
(+= content (.join (map monthlyEntries stringify) "\n") "\n")
(+= content "\nINTERVAL\n--------\n")
(+= content (.join (map intervalEntries stringify) "\n") "\n")
(+= content "\nBONUS\n-----\n")
(+= content (.join (map bonusEntries stringify) "\n") "\n")
(+= content "\nTODO\n----\n")
(+= content (.join (map todoEntries stringify) "\n") "\n")
(+= content "\nFILES\n-----\n")
(+= content (.join (map rewardFiles stringifyRewardFile) "\n") "\n")
(File.saveContent textFile
content))
// With rotating entries, the active one is the first one with the lowest score:
(function :EntryLabel activeLabel [:Entry e]
(let [lowScore (apply min (for label e.labels label.points))]
(doFor label e.labels (when (= lowScore label.points) (return label)))
(throw "no active?!")))
(function todayString []
(let [d (Date.now)] "$(d.getDate)-$(+ 1 (d.getMonth))-$(d.getFullYear)"))
(function isActive [:Entry e]
(case e.type
((Daily days lastDayDone)
(and !(= lastDayDone (todayString)) (contains days (.getDay (Date.now)))))
((Monthly days lastDayDone)
// TODO logic
(let [&mut nextDay
(DateTime.fromDate (Date.now))
oneDayInterval (DateTimeInterval.create (DateTime.make 1970 1 1) (DateTime.make 1970 1 2))
dayToEndSearch
(if lastDayDone
(DateTime.fromString lastDayDone)
(let [&mut now (DateTime.fromDate (Date.now))]
(until (= 1 (now.getDay)) #{now -= oneDayInterval;}#)
now))]
(until (and (= (nextDay.getDay) (dayToEndSearch.getDay)) (= (nextDay.getMonth) (dayToEndSearch.getMonth)) (= (nextDay.getYear) (dayToEndSearch.getYear)))
(let [daysInMonth (DateTime.daysInMonth (nextDay.getMonth) (nextDay.isLeapYear))
adjustedDays (for day days (% (+ daysInMonth day) daysInMonth))]
(when (contains adjustedDays (nextDay.getDay)) (return true)))
#{nextDay -= oneDayInterval;}#)
(return false)))
((Interval days lastDayDone)
(or !lastDayDone (<= days #{(DateTime.fromDate(Date.now()) - DateTime.fromString(lastDayDone)).getTotalDays();}#)))
(Todo (= 0 .points (activeLabel e)))
(otherwise true)))
(method :Array<Entry> activeDailyEntries []
(filter dailyEntries isActive))
(method :Array<Entry> activeMonthlyEntries []
(filter monthlyEntries isActive))
(method :Array<Entry> activeIntervalEntries []
(filter intervalEntries isActive))
(method :Array<Entry> activeBonusEntries []
(filter bonusEntries isActive))
(method :Array<Entry> activeTodoEntries []
(filter todoEntries isActive))