Files
kiss-vscode/projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss

998 lines
50 KiB
Plaintext

(loadFrom "kiss-tools" "src/kiss_tools/RefactorUtil.kiss")
(prop &mut :Jigsawx jigsaw)
(prop &mut :FlxCamera pieceCamera)
(prop &mut :FlxCamera uiCamera)
(defAlias &ident textSize SimpleWindow.textSize)
(prop &mut :FlxPomTimer pomTimer null)
(prop &mut :FlxText availableMatchesText (new FlxText 0 0 0 "" SimpleWindow.textSize))
(method &override :Void create []
(set FlxG.sound.soundTrayEnabled false)
(set FlxG.autoPause false)
(add logTexts)
(set Prelude.printStr log)
(defAndCall method newPieceCamera
(if pieceCamera
{
(FlxG.cameras.remove pieceCamera true)
(set pieceCamera (new FlxCamera))
(FlxG.cameras.add pieceCamera)
}
(set pieceCamera FlxG.camera))
(set FlxG.camera pieceCamera)
(when debugLayer
(set debugLayer.cameras [pieceCamera]))
(when uiCamera
(FlxG.cameras.remove uiCamera false)
(FlxG.cameras.add uiCamera)))
(set uiCamera (new FlxCamera))
(set SimpleWindow.defaultCamera uiCamera)
(set uiCamera.bgColor FlxColor.TRANSPARENT)
(set availableMatchesText.color FlxColor.LIME)
(set availableMatchesText.cameras [uiCamera])
(add availableMatchesText)
(FlxG.cameras.add uiCamera)
(FlxG.plugins.add (new FlxMouseControl))
(set FlxMouseControl.sortIndex "priorityID")
(set bgColor FlxColor.TRANSPARENT)
(set pomTimer (new FlxPomTimer))
(set pomTimer.cameras [uiCamera])
(super.create))
(defAlias &ident KEYBOARD_SCROLL_SPEED (keyboardScrollSpeed))
(method keyboardScrollSpeed []
(fHalf (max rewardSprite.pixels.width rewardSprite.pixels.height)))
(prop &mut :EntryType typeAdding Todo)
(prop &mut :Array<String> labelsAdding [])
(prop &mut :Bool addingLabels false)
(prop &mut :KissInputText entryNameText)
(prop &mut :DebugLayer debugLayer null)
(prop &mut t 1)
(prop :FlxRect disableMouse (new FlxRect 0 0 0 0))
(method &override :Void update [:Float elapsed]
(prop :Array<Function> nextFrameFunctions [])
(method nextFrame [:Function f]
(nextFrameFunctions.push f))
(when nextFrameFunctions
(whileLet [f (nextFrameFunctions.shift)]
(f)))
(set availableMatchesText.text "$(countAvailableMatches) matches can be made.")
(set availableMatchesText.y (- FlxG.height availableMatchesText.height))
(set availableMatchesText.x (- FlxG.width availableMatchesText.width))
// workaround for text box somehow losing focus:
(when entryNameText (set entryNameText.hasFocus true))
(super.update elapsed)
(when (and pomWasRunning !pomResumeWindow !pomStartCheck)
(entryWindow.hide)
(set pomStartCheck true)
(set pomResumeWindow
(SimpleWindow.promptForChoice "A pomodoro timer was interrupted. Resume it now?"
[
"Yes"
"No"
]
->:Void [:String choice]
(case choice
("Yes" (startPomodoros)(backToEntryWindow))
("No"
(set pomWasRunning false)
(backToEntryWindow))
(never otherwise))
null null FlxColor.LIME 0.9 0.9 true xKey null null ->[] {(set pomWasRunning false)(backToEntryWindow)})))
(if (windowIsShown)
{
(set FlxMouseControl.mouseZone disableMouse)
(when FlxMouseControl.dragTarget
(FlxMouseControl.dragTarget.stopDrag)
(set FlxMouseControl.dragTarget null))
}
(set FlxMouseControl.mouseZone null))
(#when debug
(debugLayer.clear)
(when (and model.rewardFiles rewardSprites.alive FlxG.debugger.visible)
(doFor s rewardSprites
(let [i (dictGet indexMap s)
jig (dictGet pieceData i)]
(kiss_flixel.SpriteTools.writeOnSprite "$i" 32 s (object x (Percent 0.5) y (Percent 0.5)) FlxColor.RED)
(kiss_flixel.SpriteTools.writeOnSprite "(${jig.col},${jig.row})" 32 s (object x (Percent 0.5) y (Percent 0.7)) FlxColor.RED))
(let [matchZones [(matchZoneLeft s) (matchZoneRight s)(matchZoneUp s)(matchZoneDown s)]]
(doFor z matchZones
(unless z.isEmpty
(debugLayer.drawFlxRect z FlxColor.RED)))))))
(when model.rewardFiles
(unless (or bar (windowIsShown))
(let [zoom pieceCamera.zoom
scroll (pieceCamera.scroll.copyTo)]
(pieceCamera.updateScrollWheelZoom elapsed 5)
(pieceCamera.updateMouseBorderControl elapsed KEYBOARD_SCROLL_SPEED 0.002 uiCamera)
(when (or !(= zoom pieceCamera.zoom) !(scroll.equals pieceCamera.scroll))
(set save.data.zoom pieceCamera.zoom)
(set save.data.scroll pieceCamera.scroll)
(save.flush))))
(when (and entryWindow !(tempWindowIsShown))
(when FlxG.keys.justPressed.ESCAPE
(if (entryWindow.isShown)
(entryWindow.hide)
(entryWindow.show))))
(#when debug
(when FlxG.keys.justPressed.SEMICOLON
(set pieceCamera.zoom 1))
**(when FlxG.keys.justPressed.CONTROL
(set save.data.storedPositions (new Map<Int,FlxPoint>))
(set save.data.storedAngles (new Map<Int,Float>))
(set save.data.storedOrigins (new Map<Int,FlxPoint>))
(save.flush))))
(unless (and entryNameText entryNameText.alive)
(when FlxG.keys.justPressed.DELETE
(Sys.exit 0)))
// TODO provide a saner/configurable set of bindings to trigger these ui action functions
{
(unless (windowIsShown)
(when (or FlxG.mouse.justPressedRight FlxG.keys.justPressed.R)
(when draggingSprite
(draggingSprite.rotate 90)
(doFor s (recursivelyConnectedPieces draggingSprite)
(dictSet (the Map<Int,Float> save.data.storedAngles) (dictGet indexMap s) s.angle)
(dictSet (the Map<Int,FlxPoint> save.data.storedOrigins) (dictGet indexMap s) s.origin))
(save.flush))))
(method :Void startAdding [:EntryType type]
(set typeAdding type)
(set labelsAdding [])
(set addingLabels true)
(localVar typeDescriptor
(case type
(Bonus "bonus habit")
(Todo "task")
((Daily _ _) "daily task")
((Monthly _ _) "monthly task")
((Interval _ _) "interval task")
(null (throw "type should never be null"))))
(localVar multipleLabelDescriptor
(case type
(Bonus "cycle of alternating habits")
(otherwise "series of steps for completing this task")))
(localVar title
"Add a label for this ${typeDescriptor}, or use SHIFT+ENTER to add a ${multipleLabelDescriptor}:")
(set entryCreationWindow (new SimpleWindow title null null 0.9 0.9 true xKey leftKey rightKey backToEntryWindow))
(set entryNameText (defAndCall method newNameInputText
(let [t (new KissInputText 0 0 FlxG.width "" textSize true)]
(set t.customFilterPattern (new EReg (R.oneOfChars #"/+$*[]{}"# ) ""))
t)))
(entryCreationWindow.addControl entryNameText)
(entryCreationWindow.makeText "Create" FlxColor.LIME ->:Void _ (addCreatedEntry))
(when entryWindow
(set entryWindow.keyboardEnabled false))
(entryCreationWindow.show)
(set entryNameText.hasFocus true))
(when (and entryNameText FlxG.keys.justPressed.ENTER)
(cond
((and FlxG.keys.pressed.SHIFT addingLabels)
(when (entryNameText.text.trim)
(entryCreationWindow.makeText entryNameText.text)
(labelsAdding.push entryNameText.text)
(set entryNameText.text "")
(set entryNameText.caretIndex 0)))
(addingLabels
(addCreatedEntry))
(true
(startAddingInterval))))
}
// Left and right arrow keys can switch between unlocked puzzles
(unless (or entryNameText (tempWindowIsShown))
(when FlxG.keys.justPressed.LEFT
(defAndCall method clearBar
(when bar
(remove bar)
(remove asyncLoop)))
(unless (= rewardFileIndex minRewardFile)
--rewardFileIndex
(while .skipped (nth model.rewardFiles rewardFileIndex)
--rewardFileIndex)
(refreshModel)))
(when FlxG.keys.justPressed.RIGHT
(clearBar)
(unless (= rewardFileIndex maxRewardFile)
++rewardFileIndex
(while .skipped (nth model.rewardFiles rewardFileIndex)
++rewardFileIndex)
(refreshModel)))))
(prop &mut :FlxSave save null)
(prop &mut :SimpleWindow entryWindow null)
(prop &mut :SimpleWindow puzzlePackChoiceWindow null)
(prop &mut :SimpleWindow entryDeletionWindow null)
(prop &mut :SimpleWindow entryEditWindow null)
(prop &mut :SimpleWindow entryCreationWindow null)
(prop &mut :SimpleWindow priorityWindow null)
(prop &mut :SimpleWindow pomResumeWindow null)
(method windowIsShown []
(or (tempWindowIsShown) (and entryWindow (entryWindow.isShown))))
(method tempWindowIsShown []
(doFor window [puzzlePackChoiceWindow entryDeletionWindow entryCreationWindow priorityWindow entryEditWindow pomResumeWindow]
(when (and window (window.isShown))
(return true)))
false)
(prop &mut :FlxTypedGroup<FlxText> logTexts (new FlxTypedGroup))
(prop &mut :HabitModel model null)
(method smallerDimension [] (min rewardSprite.pixels.width rewardSprite.pixels.height))
// TODO these variables don't do exactly what I think they do when scaled, like at all:
(defAlias &ident EDGE_LEEWAY 25)
(defAlias &ident BUBBLE_SIZE 15)
(defAlias &ident PUZZLE_WIDTH .puzzleWidth (nth model.rewardFiles rewardFileIndex))
(defAlias &ident PUZZLE_HEIGHT .puzzleHeight (nth model.rewardFiles rewardFileIndex))
(method roughOptimalScale []
(* (/ (max PUZZLE_WIDTH PUZZLE_HEIGHT) MIN_PUZZLE_SIZE) (/ 367 (smallerDimension))))
(defAlias &ident TOTAL_PIECES (* PUZZLE_WIDTH PUZZLE_HEIGHT))
(prop &mut :FlxSprite rewardSprite null)
(prop &mut :FlxTypedGroup<KissExtendedSprite> rewardSprites null)
(prop &mut :Map<Int,KissExtendedSprite> matchingPiecesLeft (new Map))
(prop &mut :Map<Int,KissExtendedSprite> matchingPiecesRight (new Map))
(prop &mut :Map<Int,KissExtendedSprite> matchingPiecesUp (new Map))
(prop &mut :Map<Int,KissExtendedSprite> matchingPiecesDown (new Map))
(prop &mut :Map<Int,JigsawPiece> pieceData (new Map))
(prop &mut :Map<Int,Array<KissExtendedSprite>> connectedPieces (new Map))
(prop &mut :Map<KissExtendedSprite,Int> indexMap (new Map))
(prop &mut :Map<Int,KissExtendedSprite> spriteMap (new Map)) // Because rewardSprites will be re-ordered in depth handling, this is required
(prop &mut lastRewardFileIndex -1)
(prop &mut rewardFileIndex 0)
(prop &mut :Null<Int> minRewardFile null)
(prop &mut :Null<Int> maxRewardFile null)
(defAlias &ident SCROLL_BOUND_MARGIN (scrollBoundMargin))
(method scrollBoundMargin []
(max rewardSprite.pixels.width rewardSprite.pixels.height))
(prop &mut :KissExtendedSprite draggingSprite null)
(prop &mut :FlxPoint draggingLastPos null)
// Main.hx sets off 99% of the app's logic by parsing the model file and calling setModel on startup and on a 30s loop:
(method backToEntryWindow []
(when priorityWindow (set priorityWindow.cameraColumn 0))
(set entryNameText null)
(nextFrame ->(entryWindow.show)))
(method :Void setModel [m &opt :RewardFile currentRewardFile]
(set model m)
(set pomTimer.onFinishedPom ->:Void {(model.addPomPoint) (refreshModel) (entryWindow.hide)})
(set pomTimer.onStartPom ->:Void (entryWindow.show))
(let [p (m.totalPoints)
&mut i 0
&mut puzzleUnlocked -1]
// Find, load, and add the current reward image as big as possible:
(unless currentRewardFile
(set currentRewardFile (nth m.rewardFiles 0))
(cond
((and m.rewardFiles !.skipped (last m.rewardFiles))
(while (> p .startingPoints (nth m.rewardFiles i))
(set rewardFileIndex i)
(set currentRewardFile (nth m.rewardFiles i))
(unless minRewardFile
(unless .skipped (nth m.rewardFiles i)
(set minRewardFile i)))
(unless .skipped (nth m.rewardFiles i)
(set maxRewardFile i))
(when (>= ++i m.rewardFiles.length)
--i
(let [lastStartingPoints .startingPoints (nth m.rewardFiles i)
piecesPerPoint .piecesPerPoint (nth m.rewardFiles i)
nextStartingPoints (+ lastStartingPoints (Math.ceil (/ TOTAL_PIECES piecesPerPoint)))]
(when (> p nextStartingPoints)
(set puzzleUnlocked nextStartingPoints))
(break)))))
((and m.rewardFiles .skipped (last m.rewardFiles))
(set puzzleUnlocked (max 0 (- p 1))))
(true
(set puzzleUnlocked 0))))
(when m.rewardFiles
(makeRewardSprites m p currentRewardFile))
(localVar &mut windowWasShown true)
(localVar &mut :Null<Int> cameraColumn null)
(when entryWindow
(set cameraColumn entryWindow.cameraColumn)
(set windowWasShown (entryWindow.isShown))
(entryWindow.hide))
(set entryWindow (new SimpleWindow "" (FlxColor.fromRGBFloat 0 0 0 0.5) FlxColor.WHITE 0.9 0.9))
(set entryWindow.cameras [uiCamera])
(set entryWindow.textColor FlxColor.LIME)
(when m.rewardFiles
(_makeText "Puzzle #$(+ 1 rewardFileIndex) / ${model.rewardFiles.length}" (max 0 (- TOTAL_PIECES (* currentRewardFile.piecesPerPoint (- p currentRewardFile.startingPoints)))))
(set entryWindow.textColor (FlxColor.fromRGBFloat 0.2 0.2 0.2))
(_makeText "{space} Cycle background color" 0
->_
(defAndCall method toggleBackgroundColor
(set save.data.backgroundIndex #{(save.data.backgroundIndex + 1) % backgroundOptions.length;}#)
(save.flush)
(refreshModel)))
(set entryWindow.textColor (FlxColor.LIME.getDarkened))
(_makeText "Create a habit or task" 0
->_
(defAndCall method createHabitOrTask
(entryWindow.hide)
(set entryCreationWindow (SimpleWindow.promptForChoice "Create which type of habit/task?"
[
"Daily: every day, or on specific days of the week"
"Monthly: on specific days of the month, or specific # of days before the end of the month"
"Interval: needs to be done again after specific # of days"
"Task: only needs to be done once"
"Bonus: can be done to earn points at any time, any number of times"
]
->:Void [:String choice]
(case (.takeUntilAndDrop (kiss.Stream.fromString choice) ":")
((Some "Daily") (createDailyEntry))
((Some "Monthly") (createMonthlyEntry))
((Some "Interval") (createIntervalEntry))
((Some "Task") (createTaskEntry))
((Some "Bonus") (createBonusEntry))
(otherwise (throw "nonexistent choice")))
null null FlxColor.LIME 0.9 0.9 true xKey leftKey rightKey backToEntryWindow))))
(_makeText "Choose Top-Priority habits and tasks" 0
->_
(defAndCall method choosePriorities
(entryWindow.hide)
(let [cameraColumn (when priorityWindow priorityWindow.cameraColumn)
pw (SimpleWindow.promptForChoice "Choose your top priorities. A ! will appear in front of them"
(model.allUndeletedEntries)
->:Void [:Entry e] {
(model.toggleEntryPriority e)
(model.save)
(refreshModel)
(priorityWindow.clearActions)
(priorityWindow.show)
(nextFrame ->{
(priorityWindow.hide)
(choosePriorities)
})
}
null null FlxColor.WHITE 0.9 0.9 true (defAndReturn prop xKey "escape") (defAndReturn prop leftKey "left") (defAndReturn prop rightKey "right") backToEntryWindow true)]
(pw.show cameraColumn)
(set priorityWindow pw))))
(_makeText "Edit a habit or task's labels" 0
->_
(defAndCall method chooseEditLabels
(entryWindow.hide)
(let [editWindow (SimpleWindow.promptForChoice "Edit which habit/task's labels?"
(model.allUndeletedEntries)
editLabels
null null FlxColor.WHITE 0.9 0.9 true xKey leftKey rightKey backToEntryWindow true)]
(set entryEditWindow editWindow))))
(let [showOrHide (if model.showLowerPriority "Hide" "Show")]
(_makeText "$showOrHide lower-priority habits and tasks" 0
->_
(defAndCall method toggleLowerPriority
(set model.showLowerPriority !model.showLowerPriority)
(refreshModel))))
(prop &mut pomRunning false)
(prop &mut pomStartCheck false)
(savedVar :Bool pomWasRunning false)
(if pomRunning
(_makeText "Stop Pomodoro Timer Mode" m.pomodoroPoints
->_ (defAndCall method stopPomodoros
(set pomRunning false)
(set pomWasRunning false)
(remove pomTimer)
(refreshModel)))
(_makeText "Start Pomodoro Timer Mode" m.pomodoroPoints
->_
(defAndCall method startPomodoros
(set pomRunning true)
(set pomWasRunning true)
(if FlxPomTimer.workMode
(entryWindow.show)
(entryWindow.hide))
(add pomTimer)
(refreshModel))))
(set entryWindow.textColor (FlxColor.RED.getDarkened))
(_makeText "Reset Pomodoro Timer" 0
->_ {
(stopPomodoros)
(FlxPomTimer.resetTimer)
})
(_makeText "Delete a habit or task" 0
->_
(defAndCall method deleteHabitOrTask
(entryWindow.hide)
(let [delWindow (SimpleWindow.promptForChoice "Delete which habit/task? (You will keep all your points)"
(model.allUndeletedEntries)
->:Void [:Entry e] {
(model.deleteEntry e)
(model.save)
(refreshModel)
(entryWindow.show)
}
null null FlxColor.WHITE 0.9 0.9 true xKey leftKey rightKey backToEntryWindow true)]
(set entryDeletionWindow delWindow))))
(when (= rewardFileIndex (- m.rewardFiles.length 1))
(_makeText "Abandon this puzzle" 0
->_
(defAndCall method skipPuzzle
(entryWindow.hide)
(model.skipRewardFile)
(setModel model)))))
(set entryWindow.textColor FlxColor.ORANGE)
(map (m.activeDailyEntries) makeText)
(set entryWindow.textColor FlxColor.GREEN)
(map (m.activeMonthlyEntries) makeText)
(set entryWindow.textColor FlxColor.CYAN)
(map (m.activeIntervalEntries) makeText)
(set entryWindow.textColor FlxColor.WHITE)
(map (m.activeBonusEntries) makeText)
(set entryWindow.textColor FlxColor.YELLOW)
(map (m.activeTodoEntries) makeText)
(when windowWasShown
(entryWindow.show cameraColumn))
(when !(= puzzleUnlocked -1)
(startPuzzlePackChoice puzzleUnlocked)))
(when debugLayer
(remove debugLayer))
(unless debugLayer
(set debugLayer (new DebugLayer))
(set debugLayer.cameras [pieceCamera]))
(add debugLayer))
(method refreshModel [&opt m]
(let [m (or m model)]
(setModel m (nth m.rewardFiles rewardFileIndex))))
(prop &mut textY 0)
(prop :Array<FlxColor> backgroundOptions [
FlxColor.BLACK
FlxColor.WHITE
FlxColor.GRAY
])
(function nameForSave [:String name]
(doFor forbiddenChar (.split #"~%&\;:"',<>?# "# "")
(set name (name.replace forbiddenChar "")))
name)
(method makeRewardSprites [m p currentRewardFile]
(set save (new FlxSave))
(assert (save.bind (nameForSave currentRewardFile.path)) "failed to bind save data")
(unless save.data.storedPositions
(set save.data.storedPositions (new Map<Int,FlxPoint>)))
(unless save.data.storedAngles
(set save.data.storedAngles (new Map<Int,Float>)))
(unless save.data.storedOrigins
(set save.data.storedOrigins (new Map<Int,FlxPoint>)))
(unless save.data.backgroundIndex
(set save.data.backgroundIndex 0))
(unless (and (= lastRewardFileIndex rewardFileIndex) (= lastTotalPoints (m.totalPoints)))
// When the current puzzle has changed:
(unless (= lastRewardFileIndex rewardFileIndex)
// Make a new camera so scroll from the last puzzle doesn't start the camera out of boundS
(newPieceCamera)
(set pieceCamera.bgColor (nth backgroundOptions save.data.backgroundIndex))
(set rewardSprite
(new FlxSprite 0 0
(BitmapData.fromFile
currentRewardFile.path)))
(set matchingPiecesLeft (new Map))
(set matchingPiecesRight (new Map))
(set matchingPiecesUp (new Map))
(set matchingPiecesDown (new Map))
(set pieceData (new Map))
(set connectedPieces (new Map))
(doFor i (range TOTAL_PIECES) (dictSet connectedPieces i []))
(set indexMap (new Map))
(set spriteMap (new Map))
(rewardSprite.setGraphicSize FlxG.width 0)
(rewardSprite.updateHitbox)
(when (> rewardSprite.height FlxG.height)
(rewardSprite.setGraphicSize 0 FlxG.height))
(rewardSprite.updateHitbox)
(rewardSprite.screenCenter)
(unless save.data.zoom
(set pieceCamera.zoom rewardSprite.scale.x))
// TODO the rewardSprite can be the "box image" for player reference
(rewardSprite.scale.set 1 1)
(when rewardSprites
#{
var plugin = FlxG.plugins.get(DragToSelectPlugin);
plugin.clearEnabledSprites();
}#
(rewardSprites.destroy)
(remove rewardSprites)
(set rewardSprites null)))
(unless rewardSprites
(set rewardSprites (new FlxTypedGroup))
// add rewardSprites group before enabling drag-to-select on instances, but kill it so pieces aren't rendered until they are all loaded
(add rewardSprites)
(rewardSprites.kill))
(let [r (new FlxRandom (Strings.hashCode currentRewardFile.path))
ros (roughOptimalScale)
graphicWidth (* ros rewardSprite.pixels.width)
graphicHeight (* ros rewardSprite.pixels.height)
pieceAssetWidth (/ (- graphicWidth (* EDGE_LEEWAY 2)) PUZZLE_WIDTH)
pieceAssetHeight (/ (- graphicHeight (* EDGE_LEEWAY 2)) PUZZLE_HEIGHT)
j (new Jigsawx pieceAssetWidth pieceAssetHeight graphicWidth graphicHeight EDGE_LEEWAY BUBBLE_SIZE PUZZLE_HEIGHT PUZZLE_WIDTH r)
PIECE_WIDTH
(/ rewardSprite.width PUZZLE_WIDTH)
PIECE_HEIGHT
(/ rewardSprite.height PUZZLE_HEIGHT)
:Array<FlxPoint> startingPoints []
:Array<Float> startingAngles []]
(let [&mut i 0]
(doFor y (range PUZZLE_HEIGHT)
(doFor x (range PUZZLE_WIDTH)
(startingAngles.push (* 90 (r.int 0 3)))
(startingPoints.push
(new FlxPoint (+ rewardSprite.x (* x PIECE_WIDTH)) (+ rewardSprite.y (* y PIECE_HEIGHT))))
(+= i 1))))
(r.shuffle startingPoints)
(set jigsaw j)
(r.shuffle jigsaw.jigs)
(localVar piecesUnlocked (min TOTAL_PIECES (* currentRewardFile.piecesPerPoint (- p currentRewardFile.startingPoints))))
(localVar piecesAlreadyMade rewardSprites.length)
(localVar newPieces (- piecesUnlocked piecesAlreadyMade))
(prop &mut :Array<Array<KissExtendedSprite>> spriteGrid)
(prop &mut :Array<Array<Int>> indexGrid)
(unless (< 0 piecesAlreadyMade)
(set spriteGrid (for y (range PUZZLE_HEIGHT) (for x (range PUZZLE_WIDTH) null)))
(set indexGrid (for y (range PUZZLE_HEIGHT) (for x (range PUZZLE_WIDTH) -1))))
(localVar makeJig -+>count []
(let [i (+ piecesAlreadyMade count -1)
jig (nth jigsaw.jigs i)
pos (ifLet [point (dictGet (the Map<Int,FlxPoint> save.data.storedPositions) i)]
point
(.addPoint (nth startingPoints i) camera.scroll))
angle (ifLet [angle (dictGet (the Map<Int,Float> save.data.storedAngles) i)]
angle
(nth startingAngles i))
&mut s (dictGet spriteMap i)
source (new FlxSprite)
mask (new FlxSprite)
sourceRect (new Rectangle (/ jig.xy.x ros) (/ jig.xy.y ros) (/ jig.wh.x ros) (/ jig.wh.y ros))]
(unless s
(set s (new KissExtendedSprite pos.x pos.y))
(set s.angle angle)
(set s.priorityID i)
(dictSet (the Map<Int,FlxPoint> save.data.storedPositions) i pos)
(setNth spriteGrid jig.row jig.col s)
(setNth indexGrid jig.row jig.col i)
(dictSet pieceData i jig)
(dictSet indexMap s i)
(dictSet spriteMap i s)
(set s.draggable true)
(s.enableMouseDrag false true)
(set s.mouseStartDragCallback
->:Void [s x y]
(let [s (cast s KissExtendedSprite)]
(set s.priorityID (+ 1 .priorityID (last (the kiss.List<KissExtendedSprite> rewardSprites.members))))
(let [connectedPieces (recursivelyConnectedPieces s)]
// Bring currently held pieces to the front:
(rewardSprites.bringAllToFront connectedPieces))
(set draggingSprite s)
(set draggingLastPos (new FlxPoint s.x s.y))))
(set s.mouseStopDragCallback
->:Void [s x y]
(let [s (cast s KissExtendedSprite)]
(set draggingSprite null)
(let [connectedPieces (.concat (s.connectedAndSelectedSprites) [s])]
(doFor connected connectedPieces
(checkMatches (dictGet indexMap connected)))
(doFor connected connectedPieces
(dictSet (the Map<Int,FlxPoint> save.data.storedPositions) (dictGet indexMap connected) (new FlxPoint connected.x connected.y))))
(pieceCamera.calculateScrollBounds rewardSprites uiCamera SCROLL_BOUND_MARGIN)
(save.flush)))
(var ROT_PADDING 4)
(localVar fWidth (+ (Std.int sourceRect.width) (* 2 ROT_PADDING)))
(localVar fHeight (+ (Std.int sourceRect.height) (* 2 ROT_PADDING)))
(source.makeGraphic fWidth fHeight FlxColor.TRANSPARENT true)
(source.pixels.copyPixels rewardSprite.pixels sourceRect (new Point ROT_PADDING ROT_PADDING))
(mask.makeGraphic fWidth fHeight FlxColor.TRANSPARENT true)
(drawPieceShape mask jig ros FlxColor.BLACK)
(localVar unhighlightedS (new FlxSprite))
(FlxSpriteUtil.alphaMask unhighlightedS source.pixels mask.pixels)
(localVar highlightedS (new FlxSprite))
(s.loadGraphic unhighlightedS.pixels)
(highlightedS.loadGraphic unhighlightedS.pixels false 0 0 true)
(drawPieceShape highlightedS jig ros FlxColor.TRANSPARENT FlxColor.LIME)
(localFunction loadRotatedGraphic [:FlxSprite _s]
(s.loadRotatedGraphic _s.pixels 4 -1))
(loadRotatedGraphic unhighlightedS)
(s.enableDragToSelect
->:Void {
(loadRotatedGraphic highlightedS)
}
->:Void {
(loadRotatedGraphic unhighlightedS)
})
(set s.cameras [pieceCamera])
(rewardSprites.add s))))
(prop &mut :FlxBar bar null)
(prop &mut :FlxAsyncLoop asyncLoop null)
(set bar (new FlxBar 0 0 LEFT_TO_RIGHT (iThird FlxG.width) SimpleWindow.textSize rewardSprites "length" 0 piecesUnlocked true))
(set bar.cameras [uiCamera])
(set asyncLoop (new FlxAsyncLoop newPieces makeJig 1))
(bar.createColoredEmptyBar (FlxColor.LIME.getDarkened) true FlxColor.LIME)
(bar.createColoredFilledBar FlxColor.LIME false)
(bar.screenCenter)
(set bar.filledCallback ->:Void {
(remove bar)
(remove asyncLoop)
(rewardSprites.revive)
(doFor row (range PUZZLE_HEIGHT)
(doFor col (range PUZZLE_WIDTH)
(let [id (nth indexGrid row col)]
(when (= id -1) (continue))
(when (>= (- col 1) 0)
(let [toLeft (nth spriteGrid row (- col 1))]
(dictSet matchingPiecesLeft id toLeft)))
(when (< (+ col 1) PUZZLE_WIDTH)
(let [toRight (nth spriteGrid row (+ col 1))]
(dictSet matchingPiecesRight id toRight)))
(when (>= (- row 1) 0)
(let [toUp (nth spriteGrid (- row 1) col)]
(dictSet matchingPiecesUp id toUp)))
(when (< (+ row 1) PUZZLE_HEIGHT)
(let [toDown (nth spriteGrid (+ row 1) col)]
(dictSet matchingPiecesDown id toDown))))))
(doFor i (range TOTAL_PIECES)
(checkMatches i))
(pieceCamera.calculateScrollBounds rewardSprites uiCamera SCROLL_BOUND_MARGIN)
(when save.data.zoom
(set pieceCamera.zoom save.data.zoom)
(set pieceCamera.scroll save.data.scroll))
(set bar null)
(set asyncLoop null)
})
(add bar)
(add asyncLoop)
(asyncLoop.start)))
(set lastRewardFileIndex rewardFileIndex)
(prop &mut lastTotalPoints -1)
(set lastTotalPoints (m.totalPoints))
(set pieceCamera.bgColor (nth backgroundOptions save.data.backgroundIndex))
(save.flush))
(method makeText [:Entry e]
(let [label (HabitModel.activeLabel e)]
(_makeText label.label label.points ->:Void text {
(model.addPoint e)
(setModel model)
})))
// TODO configurable text size
(method _makeText [:String s :Int points &opt :Action action]
(entryWindow.makeText (+ s (HabitModel.pointsStr points)) action))
(method :Void log [:String message]
(trace message)
(when (> message.length (defAndReturn var FLX_LOG_MAX 100)) (set message (message.substr FLX_LOG_MAX)))
(prop &mut logTextY 0)
(#when debug
(when (> logTextY FlxG.height)
(logTexts.clear)
(set logTextY 0))
(let [text (new FlxText FlxG.width logTextY 0 message textSize)]
(set text.color FlxColor.LIME)
(set text.cameras [uiCamera])
(+= logTextY text.height)
(-= text.x text.width)
(logTexts.add text))))
(method :FlxRect matchZone [:KissExtendedSprite s compass]
(assertLet [id (dictGet indexMap s)
jig (dictGet pieceData id)]
(let [bubblePoints (dictGet jig.bubblePoints compass)]
(unless bubblePoints
(return (new FlxRect 0 0 0 0)))
(let [ros (roughOptimalScale)
pointsX (for point bubblePoints point.x)
pointsY (for point bubblePoints point.y)
minX (/ (apply min pointsX) ros)
minY (/ (apply min pointsY) ros)
maxX (/ (apply max pointsX) ros)
maxY (/ (apply max pointsY) ros)
tlc (.add (new FlxPoint minX minY) ROT_PADDING ROT_PADDING)
brc (.add (new FlxPoint maxX maxY) ROT_PADDING ROT_PADDING)
rotationPadding (s.getRotationPadding)
rect (.fromTwoPoints (new FlxRect) (tlc.addPoint rotationPadding) (brc.addPoint rotationPadding))
originOffset (new FlxPoint (- s.origin.x rect.x) (- s.origin.y rect.y))
rotated (rect.getRotatedBounds s.angle originOffset)]
(+= rotated.x s.x)
(+= rotated.y s.y)
rotated))))
(method :FlxRect matchZoneLeft [:KissExtendedSprite s]
(matchZone s WEST))
(method :FlxRect matchZoneRight [:KissExtendedSprite s]
(matchZone s EAST))
(method :FlxRect matchZoneUp [:KissExtendedSprite s]
(matchZone s NORTH))
(method :FlxRect matchZoneDown [:KissExtendedSprite s]
(matchZone s SOUTH))
(prop &mut c 0)
(method :Bool connectPiece [id self toSprite selfMatchZone toSpriteMatchZone]
(let [thisConnectedPieces (dictGet connectedPieces id)
toConnectedPieces (dictGet connectedPieces (dictGet indexMap toSprite))]
// Don't add duplicates or snap for pieces alread connected
(when (contains thisConnectedPieces toSprite)
(return false))
(+= c 1)
// Snap the pieces together
(let [offsetX (- toSpriteMatchZone.x selfMatchZone.x)
offsetY (- toSpriteMatchZone.y selfMatchZone.y)
selfAndAttached (recursivelyConnectedPieces self)
indices (for s selfAndAttached (dictGet indexMap s))
otherAndAttached (recursivelyConnectedPieces toSprite)
otherIndices (for s otherAndAttached (dictGet indexMap s))]
//(print "attaching $indices to $otherIndices")
(doFor piece selfAndAttached
(+= piece.x offsetX)
(+= piece.y offsetY))
// TODO check for matches created by snapping all the pieces?
// Or is it fine not to?
)
(thisConnectedPieces.push toSprite)
(toConnectedPieces.push self)
(let [selfAndAttached (recursivelyConnectedPieces self)]
(doFor s selfAndAttached
(set s.connectedSprites selfAndAttached)))
true))
(defMacro _checkMatch [side otherSide]
(let [sideStr (symbolNameValue side)
otherSideStr (symbolNameValue otherSide)
to (symbol "to$sideStr")
mp (symbol "matchingPieces$sideStr")
mz1 (symbol "matchZone$sideStr")
mz2 (symbol "matchZone$otherSideStr")]
`(whenLet [,to (dictGet ,mp id)
mz1 (,mz1 s)
mz2 (,mz2 ,to)]
(unless (or !(= s.angle .angle ,to) .isEmpty (mz1.intersection mz2))
(connectPiece id s ,to mz1 mz2)))))
(method :Bool checkMatches [id]
(when !(pieceData.exists id)
(return false))
(let [s (dictGet spriteMap id)
jig (dictGet pieceData id)
row jig.row
col jig.col]
(_checkMatch Left Right)
(_checkMatch Right Left)
(_checkMatch Up Down)
(_checkMatch Down Up))
false)
(method :Array<KissExtendedSprite> recursivelyConnectedPieces [s &opt :Array<KissExtendedSprite> collected]
(unless collected (set collected [s]))
(whenLet [directlyConnected (dictGet connectedPieces (dictGet indexMap s))]
(doFor piece directlyConnected
(unless (contains collected piece)
(collected.push piece)
(recursivelyConnectedPieces piece collected))))
collected)
(prop &mut :FlxGroup nextPuzzleChoiceGroup null)
(method :Void startPuzzlePackChoice [nextStartingPoints]
(when rewardSprites (rewardSprites.kill))
(when entryWindow (entryWindow.hide))
(set puzzlePackChoiceWindow (SimpleWindow.promptForChoice "Choose a puzzle pack:"
(PuzzlePack.availablePacks model)
->[:PuzzlePack pack] (ifLet [(Some np) pack.nextPuzzle]
(startPuzzleSizeChoice
->[chosenSize pointsPerPiece]
(let [bmd (BitmapData.fromFile np.path)
aspectRatioX (/ bmd.width bmd.height)
aspectRatioY (/ bmd.height bmd.width)
w (max 1 (Math.round (* aspectRatioX chosenSize)))
h (max 1 (Math.round (* aspectRatioY chosenSize)))]
(model.addRewardFile np.path nextStartingPoints w h pointsPerPiece)
(setModel model)
(entryWindow.show)))
(startPuzzlePackChoice nextStartingPoints))
null null FlxColor.LIME null 0.9)))
(var MIN_PUZZLE_SIZE 5)
(var MAX_PUZZLE_SIZE 32)
(var PUZZLE_SIZE_OPTIONS (collect (range MIN_PUZZLE_SIZE MAX_PUZZLE_SIZE 2)))
(method :Void startPuzzleSizeChoice [:StartPuzzleFunc startPuzzle]
(set puzzlePackChoiceWindow (SimpleWindow.promptForChoice "Approx. # of Pieces:"
// TODO also limit puzzle size by rewardSprite dimensions (which are available in bmd in startPuzzlePackChoice())
(for size PUZZLE_SIZE_OPTIONS (* size size))
->:Void [:Int size] (startPiecesPerPointChoice (Std.int (Math.sqrt size)) startPuzzle)
null null FlxColor.LIME null 0.9)))
(method :Void startPiecesPerPointChoice [size :StartPuzzleFunc startPuzzle]
(let [maxPPP (Math.round (/ (* size size) (* MIN_PUZZLE_SIZE MIN_PUZZLE_SIZE)))]
(when (= maxPPP 1)
(startPuzzle size 1)
(return))
(set puzzlePackChoiceWindow (SimpleWindow.promptForChoice "# of pieces to unlock per habit point:"
(collect (range 1 maxPPP))
->:Void [:Int points] (startPuzzle size points)
null null FlxColor.LIME null 0.9))))
(method createToggleIndicesType [defEnabled constructor :Array<String> days negativeStart prompt &opt width height]
(let [daysEnabled (for day days defEnabled)
daysEnabledModelFormat ->(let [:Array<Int> idxArr []]
(doFor [idx day] (enumerate daysEnabled) (when day (idxArr.push
(if (>= idx negativeStart)
(- -1 (- idx negativeStart))
(+ idx 1)))))
idxArr)
dayText ->idx "$(nth days idx): $(if (nth daysEnabled idx) "yes" "no")"
dayColor ->idx (if (nth daysEnabled idx) (FlxColor.LIME.getDarkened) FlxColor.GRAY)
window (new SimpleWindow prompt null null width height true xKey leftKey rightKey backToEntryWindow)]
(localFunction refreshWindow []
(window.clearControls)
(doFor [idx day] (enumerate days)
(window.makeText (dayText idx) (dayColor idx) ->:Void _ {
(setNth daysEnabled idx !(nth daysEnabled idx))
(refreshWindow)
}))
(window.makeText "Confirm" FlxColor.LIME ->:Void _
(when (daysEnabledModelFormat)
(window.hide)
(startAdding (constructor (daysEnabledModelFormat) "")))))
(set entryCreationWindow window)
(refreshWindow)
(window.show)))
(method createDailyEntry []
(createToggleIndicesType true Daily ["Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"] 8 "Which days of the week?"))
(method createMonthlyEntry []
(let [texts
(concat
(for d (range 28) "Day $(+ d 1)")
(for d (range 28) "$(+ d 1) days before month ends"))]
(createToggleIndicesType false Monthly (cast texts) 28 "Which days of the month?" 0.9 0.9)))
(method createIntervalEntry []
(set entryCreationWindow (new SimpleWindow "After finishing this habit, how many days do you wait before doing it again?" null null 0.9 0.9 true xKey leftKey rightKey backToEntryWindow))
(set entryNameText (new KissInputText 0 0 FlxG.width "" textSize true))
(set addingLabels false)
(entryCreationWindow.addControl entryNameText)
(entryCreationWindow.makeText "Confirm" FlxColor.LIME
->:Void _
(defAndCall method startAddingInterval
(try
(let [int (Std.parseInt entryNameText.text)]
(entryNameText.kill)
(set entryNameText null)
(entryCreationWindow.hide)
(startAdding (Interval int "")))
(catch [e] (return)))))
(entryCreationWindow.show))
(method createTaskEntry [] (startAdding Todo))
(method createBonusEntry [] (startAdding Bonus))
(method addCreatedEntry []
// addEntry() calls save()
(when (entryNameText.text.trim)
(labelsAdding.push entryNameText.text))
(unless labelsAdding
(return))
(model.addEntry typeAdding labelsAdding false) // TODO allow choosing priority!
(refreshModel)
(entryNameText.kill)
(set entryNameText null)
(entryCreationWindow.hide)
(when entryWindow
(set entryWindow.keyboardEnabled true)
(entryWindow.show)))
(defMacro withConnectedAndMatching [forOrDoFor &body body]
`(,forOrDoFor s rewardSprites.members
(let [id (dictGet indexMap s)
connectedPieces (dictGet connectedPieces id)
matchingPieces (filter (for map [matchingPiecesLeft matchingPiecesRight matchingPiecesUp matchingPiecesDown]
(dictGet map id)))]
,@body)))
(method countAvailableMatches []
(iHalf
(apply +
(withConnectedAndMatching for
(- matchingPieces.length connectedPieces.length)))))
(method :Array<Array<KissExtendedSprite>> listAvailableMatches []
(apply concat (the Array<Array<Array<KissExtendedSprite>>> (withConnectedAndMatching for
(for piece (filter matchingPieces ->p !(contains connectedPieces p))
[s piece])))))
(method editLabels [:Entry e]
(let [window (new SimpleWindow "Editing labels" null null 0.9 0.9 true xKey leftKey rightKey backToEntryWindow)
inputTexts (for l e.labels
(newNameInputText))]
// TODO allow adding more labels in between/before/at end
// TODO allow deleting labels (keep score?)
(doFor inputText inputTexts
(window.addControl inputText))
(window.makeText "Save" FlxColor.LIME ->:Void _
{
(set e.labels (for [inputText label] (zip inputTexts e.labels)
(object points label.points label inputText.text)))
(model.save)
(window.hide)
(backToEntryWindow)
})
(set entryEditWindow window)
(window.show)))