Files
kiss-flixel/src/kiss_flixel/SimpleWindow.kiss

1292 lines
56 KiB
Plaintext

(loadFrom "kiss-tools" "src/kiss_tools/RefactorUtil.kiss")
// TODO localstorage-based savedVar implementation would remove the need
// for this
(#if sys
(defAlias &call sv savedVar)
(defAlias &call sv var))
// All windows share the same text size and font.
//
(sv :Int textSize 16)
(var &mut minTextSize 8)
(var &mut maxTextSize 32)
(sv :String fontPath "")
(var &mut :Map<String,String> fonts [=>"Default" ""])
(var :kiss.List<SimpleWindow> windowStack [])
(var &mut :flixel.FlxCamera defaultCamera null)
(sv :Float screenReaderVolume 1.0)
(sv :Bool screenReaderEnabled true)
(prop :FlxCamera controlCamera)
(prop &mut keyboardEnabled true)
(prop :FlxSprite selectionMarker)
(var &mut :FlxSprite defaultSelectionMarker)
(prop &mut :Int _selectedIndex -1)
(prop :Int selectedIndex (property get set))
(method get_selectedIndex [] _selectedIndex)
(method set_selectedIndex [value]
(when (= -1 value)
(when selectionMarker
(set selectionMarker.visible false)))
(when (= value _selectedIndex) (return value))
(let [columnControls (getColumnControls)
controlToDeselect (nth columnControls _selectedIndex)
controlToSelect (nth columnControls value)]
// Disallow directly setting the SelectedIndex to a non-interactive control
(assert
(or
(= -1 value)
(dictGet _actions controlToSelect)
(> (count (or (dictGet _altActions controlToSelect) (new Map<String,Action>))) 0)
(Std.isOfType controlToSelect KissInputText)))
(when controlToDeselect
(set controlToDeselect.color (dictGet _colors controlToDeselect))
(whenLet [onDeselectLast (dictGet _onDeselectEvents controlToDeselect)]
(onDeselectLast controlToDeselect)))
(set _selectedIndex value)
(when (= -1 value) (return value))
(set controlToSelect.color (getHighlighted (dictGet _colors controlToSelect)))
// HANDLE WHEN A CONTROL IS SELECTED:
{
(when selectionMarker
(set selectionMarker.visible true)
(set selectionMarker.y controlToSelect.y)
(set selectionMarker.x (- controlToSelect.x selectionMarker.width textSize)))
// TODO method to play screenreader of all non-interactive text with a cc of playing the first interactive text audio
// TODO method to prompt explaining the screenreader and optionally asking to enable/disable/configure volume?
// play screenreader of the text (unless hidden?)
(method :Void playScreenReaderTextFor [control &opt :Void->Void cc]
(typeCase [control]
([:FlxText text]
(playScreenReaderText text.text cc))
(otherwise (print "Can't determine text for ScreenReader of SimpleWindow control $control"))))
(method _withoutForbiddenCharacters [:String text :Array<String> toReplace]
(ifLet [next (toReplace.pop)]
(_withoutForbiddenCharacters (text.replace next "") toReplace)
text))
(method withoutForbiddenCharacters [:String text]
(_withoutForbiddenCharacters text (.split "#%&{}\\<>*?/\$!'\":@+`|=" "")))
(method :Void playScreenReaderText [text &opt :Void->Void cc]
(unless (< 0 (Lambda.count screenReaderAudio)) (return))
// stop any currently playing text
// TODO is it right that the cc will never be called?
(currentAudio?.stop)
(if (and screenReaderEnabled (< 0 screenReaderVolume))
(let [text (withoutForbiddenCharacters text)]
(ifLet [audio (dictGet screenReaderAudio text)]
(playAudio audio cc)
{
(doFor =>key audio screenReaderAudio
(when (text.startsWith key)
(playAudio audio cc)
(return)))
(print "No audio found for SimpleWindow text `${text}`")
(when cc (cc))
}))
(when cc (cc))))
(prop &mut :FlxSound currentAudio)
(method playAudio [:FlxSound sound &opt :Void->Void cc]
(set sound.volume screenReaderVolume)
(set sound.onComplete cc)
(set currentAudio sound)
(sound.play))
(playScreenReaderTextFor controlToSelect)
(whenLet [onSelect (dictGet _onSelectEvents controlToSelect)]
(onSelect controlToSelect))
}
// If selectedIndex refers to a KissInputText, make it active
(typeCase [controlToSelect]
([:KissInputText inputText]
(inputTexts.forEach ->:Void [text] (set text.hasFocus false))
(set inputText.hasFocus true))
(otherwise))
value))
(method :Void setControlColor [:FlxSprite control :FlxColor newColor]
(unless control (return))
(set control.color newColor)
(dictSet _colors control newColor))
(method :Void setUIControlColor [:FlxColor newColor]
(doFor control [xText leftText rightText upText downText scrollBar]
(setControlColor control newColor)))
(method selectDown []
(let [columnControls (getColumnControls)
&mut nextIndex _selectedIndex]
(loop
(set nextIndex (% (+ 1 nextIndex) columnControls.length))
(when (or (dictGet _actions (nth columnControls nextIndex)) (Std.isOfType (nth columnControls nextIndex) KissInputText))
(set selectedIndex nextIndex)
(return)))))
(method selectUp []
(let [columnControls (getColumnControls)
&mut nextIndex _selectedIndex]
(loop
(-= nextIndex 1)
(when (< nextIndex 0)
(set nextIndex (- columnControls.length 1)))
(when (or (dictGet _actions (nth columnControls nextIndex)) (Std.isOfType (nth columnControls nextIndex) KissInputText))
(set selectedIndex nextIndex)
(return)))))
(var &mut defaultXKey "")
(var &mut defaultLeftKey "")
(var &mut defaultRightKey "")
(var &mut defaultUpKey "")
(var &mut defaultDownKey "")
(var &mut defaultEnterKey "")
(function sensibleDefaultKeys []
(set SimpleWindow.defaultXKey "escape")
(set SimpleWindow.defaultLeftKey "left")
(set SimpleWindow.defaultRightKey "right")
(set SimpleWindow.defaultUpKey "up")
(set SimpleWindow.defaultDownKey "down")
(set SimpleWindow.defaultEnterKey "enter"))
(function create [:ConstructorArgs args]
(new SimpleWindow args.title args.bgColor args.textColor args.percentWidth args.percentHeight args.xButton args.xKey
args.leftKey args.rightKey args.upKey args.downKey args.enterKey args.onClose args.selectionMarker args.screenReaderAudioFolder))
(defNew &private [&opt :String _title
:FlxColor _bgColor
:FlxColor _textColor
:Float percentWidth
:Float percentHeight
:Bool _xButton :String _xKey
:String _leftKey :String _rightKey
:String _upKey :String _downKey
:String _enterKey
:ShortcutAction _onClose
:FlxSprite _selectionMarker
:String _screenReaderAudioFolder]
[:String title (or _title "")
&mut :Float nextControlX 0
&mut :Float nextControlY 0
&mut :Int controlsPerColumn 0
:FlxColor titleColor (or _textColor FlxColor.WHITE)
&mut :FlxColor textColor (or _textColor FlxColor.WHITE)
:FlxColor bgColor (or _bgColor FlxColor.BLACK)
:Bool xButton ?_xButton
:String xKey (or _xKey defaultXKey)
:String leftKey (or _leftKey defaultLeftKey)
:String rightKey (or _rightKey defaultRightKey)
:String upKey (or _upKey defaultUpKey)
:String downKey (or _downKey defaultDownKey)
:String enterKey (or _enterKey defaultEnterKey)
&mut :ShortcutAction onClose _onClose
:FlxTypedGroup<FlxSprite> controls (new FlxTypedGroup)
:FlxKeyShortcutHandler<ShortcutAction> keyHandler (new FlxKeyShortcutHandler)
// The xHandler exists so that when keyboard shortcuts are disabled,
// UI key controls are still available. it also handles left and right.
:FlxKeyShortcutHandler<ShortcutAction> xHandler (new FlxKeyShortcutHandler)
:Int _width (Std.int (* FlxG.width (or percentWidth 0.5)))
:Int _height (Std.int (* FlxG.height (or percentHeight 0.5)))
:String screenReaderAudioFolder _screenReaderAudioFolder
:Map<String,FlxSound> screenReaderAudio (new Map)]
(assert FlxG.camera "SimpleWindow.new() must be called in or after create()")
(super 0 0)
// TODO this relies on readDirectory() which can't be done in JavaScript for HTML5 games
(#when sys
(when screenReaderAudioFolder
(let [audioFiles (sys.FileSystem.readDirectory screenReaderAudioFolder)]
(doFor file audioFiles
(dictSet screenReaderAudio (file.withoutExtension) (FlxG.sound.load (joinPath screenReaderAudioFolder file)))))))
(when defaultCamera (set this.cameras [defaultCamera]))
(makeGraphic
_width
_height
bgColor
true)
(flixel.util.FlxSpriteUtil.drawRect this 0 0 _width _height FlxColor.TRANSPARENT (object color textColor))
(screenCenter)
(set selectionMarker (or _selectionMarker (defaultSelectionMarker?.clone)))
(set controlCamera (new FlxCamera (Std.int x) (Std.int y) (Std.int width) (Std.int height)))
(set controlCamera.bgColor FlxColor.TRANSPARENT)
// Top-left corner for controls is (0,0) because a camera displays them
(set nextControlX 0)
(when selectionMarker
(set nextControlX (+ selectionMarker.width textSize)))
(set nextControlY 0)
(let [textHeight
.height (new FlxText 0 0 0 "a" textSize)]
(set controlsPerColumn (Math.floor (/ height textHeight)))
(-= controlsPerColumn 1) // Column at the bottom for left/right scroll arrows
(when title (-= controlsPerColumn 1)))
(defAndCall method addTitle
(when title
(set titleText (makeText title titleColor))))
(set keyHandler.onBadKey ->:Void [key context]
(unless (= key xKey)
(#when debug
(print "bad key $key in context $context"))))
(set keyHandler.onSelectItem
->:Void [:ShortcutAction a] {
(a)
(keyHandler.start)
})
(prop &mut :Bool justPressedUIButton false)
(set xHandler.cancelKey null)
(set xHandler.onBadKey ->:Void [key context] 0)
(set xHandler.onSelectItem
->:Void [:ShortcutAction a] {
(set justPressedUIButton true)
(a)
(xHandler.start)
})
(when upKey
(xHandler.registerItem "{${upKey}}" selectUp true))
(when downKey
(xHandler.registerItem "{${downKey}}" selectDown true))
(when enterKey
(xHandler.registerItem "{${enterKey}}"
->:Void
(unless (= -1 _selectedIndex)
(let [selectedControl (nth (getColumnControls) _selectedIndex)]
((dictGet _actions selectedControl) selectedControl))) true))
(defAndCall method makeXControls
(let [closeAction ->:Void {(hide)(when onClose (onClose))}]
(when xButton
(let [ftext (new FlxText width 0 0 "X" textSize)]
(when fontPath
(set ftext.font fontPath))
(set ftext.cameras [controlCamera])
(-= ftext.x ftext.width)
(set ftext.color textColor)
(dictSet _colors ftext ftext.color)
(dictSet _actions ftext ->:Void _ (closeAction))
(set xText ftext)
(controls.add xText)))
(when xKey
(when (= keyHandler.cancelKey xKey)
(set keyHandler.cancelKey null))
(xHandler.registerItem "{${xKey}}" closeAction true)))))
(prop :FlxTypedGroup<KissInputText> inputTexts (new FlxTypedGroup))
(prop &mut :Array<FlxSprite> nonLayoutControls [])
(method :kiss.List<FlxSprite> getColumnControls []
(let [columnControls (controls.members.slice (if title 1 0))]
// Don't count special controls as part of any column:
(doFor c [xText leftText rightText upText downText]
(when c (columnControls.remove c)))
(doFor c columnTexts
(when c (columnControls.remove c)))
(doFor c nonLayoutControls
(when c (columnControls.remove c)))
(columnControls.remove scrollBar)
columnControls))
(prop &mut horiz false)
(prop &mut beforeHorizX 0.0)
(method toggleRowLayout []
(if horiz
{
(set nextControlX beforeHorizX)
(+= nextControlY .height (last (getColumnControls)))
}
(set beforeHorizX nextControlX))
(set horiz !horiz))
(method addControl [:FlxSprite control &opt :Bool ignoreLayout]
(when ?ignoreLayout
(nonLayoutControls.push control))
(typeCase [control]
([:KissInputText control]
(when fontPath
(set control.font fontPath))
(set control.size textSize)
(inputTexts.add control))
(otherwise))
(set control.cameras [controlCamera])
(controls.add control)
(unless ?ignoreLayout
(set control.x nextControlX)
(set control.y nextControlY)
(if horiz
(+= nextControlX control.width)
(+= nextControlY control.height))
// TODO controls that aren't the same height as text will be able to vertically overflow
(unless _useScrolling
(let [columnControls (getColumnControls)
&mut newControlWidth (+ control.width textSize)]
(when selectionMarker
(+= newControlWidth selectionMarker.width textSize))
(setNth columnWidths -1 (max newControlWidth (last columnWidths)))
(when (and columnControls (= 0 (% columnControls.length controlsPerColumn)))
(set nextControlY 0)
(when title (+= nextControlY control.height))
(+= nextControlX (last columnWidths))
(columnWidths.push 0)
(when (> (apply + columnWidths) width)
(makeScrollArrows))))))
control)
(prop &mut :Bool _useScrolling false)
(prop &mut :KissExtendedSprite scrollBar null)
(prop &mut :Float scrollBarMin 0)
(prop &mut :Float scrollBarMax 0)
(prop &mut :Null<Int> scrollStepsPossible null)
(prop &mut :Bool draggingScrollBar false)
// Measure how much scrolling is possible in this thang for the scrollBar
(method :Void measureVerticalScrolling []
(set scrollStepsPossible 0)
(while (_scrollUp true) null)
(while (_scrollDown true)
(+= scrollStepsPossible 1))
(while (_scrollUp true)
null)
(when (= 0 scrollStepsPossible) (return))
(let [columnControls
(getColumnControls)
numVisibleControls
(->(doFor i (range columnControls.length)
(when .isEmpty (.intersection (controlCamera.getViewRect) (.getScreenBounds (nth columnControls i) controlCamera))
(return (- i 1)))))
scrollBarHeight (Std.int (* (- scrollBarMax scrollBarMin) (/ numVisibleControls columnControls.length)))]
(scrollBar.setGraphicSize (Std.int scrollBar.width) scrollBarHeight)
(scrollBar.updateHitbox)
(once (FlxG.plugins.add (new FlxMouseControl)))
(scrollBar.enableMouseDrag (new FlxRect scrollBar.x scrollBar.y scrollBar.width (- scrollBarMax scrollBarMin)))
(set scrollBar.mouseStartDragCallback ->[_ _ _]
(set draggingScrollBar true))
(set scrollBar.mouseStopDragCallback ->[_ _ _] {
(positionScrollBar)
(set draggingScrollBar false)
})
(-= scrollBarMax scrollBarHeight)))
(method enableVerticalScrolling []
(set _useScrolling true)
(set mouseMode true)
// add scroll up/scroll down buttons
(assert xText)
(set upText (new FlxText xText.x (+ xText.y xText.height) 0 "v" textSize))
(set upText.color textColor)
(set upText.flipY true)
(dictSet _colors upText upText.color)
(dictSet _actions upText ->:Void _ (scrollUp))
(set upText.cameras [controlCamera])
(controls.add upText)
(set downText (upText.clone))
(dictSet _colors downText upText.color)
(dictSet _actions downText ->:Void _ (scrollDown))
(set downText.cameras [controlCamera])
(set downText.flipY false)
(set downText.x upText.x)
(set downText.y (- _height downText.height))
(controls.add downText)
(let [scrollBarWidth (iHalf textSize)]
(set scrollBarMin (+ upText.y upText.height))
// the scrollBarMax will be overridden when measureVerticalScrolling() is called
(set scrollBarMax downText.y)
(set scrollBar (new KissExtendedSprite))
// The height will also be overridden
(scrollBar.makeGraphic scrollBarWidth 1 textColor)
(dictSet _colors scrollBar textColor)
(set scrollBar.x
(- (+ upText.x (fHalf upText.width))
(fHalf scrollBarWidth)))
(set scrollBar.y scrollBarMin)
(set scrollBar.cameras [controlCamera])
(controls.add scrollBar))
// register upKey/downKey
(when upKey
(xHandler.registerItem "{${upKey}}" scrollUp true))
(when downKey
(xHandler.registerItem "{${downKey}}" scrollDown true)))
(var SCROLL_LINES 3)
(method :Bool scrollDown []
(apply or (for _ (range SCROLL_LINES) (_scrollDown))))
(prop &mut :Int currentScroll 0)
(method :Bool _scrollDown [&opt :Bool fake]
(let [:kiss.List<FlxSprite> controls (_nonUIControls)
lastControl (last controls)]
(when (< (+ lastControl.y lastControl.height) _height)
(return false))
(doFor c controls
(-= c.y c.height)
(set c.visible !?(= c.y titleText?.y)))
(unless fake
(+= currentScroll 1)
(positionScrollBar))
true))
(method :Bool _scrollUp [&opt :Bool fake]
(let [:kiss.List<FlxSprite> controls (_nonUIControls)
minY (if titleText titleText.height 0)]
(when (>= .y (first controls) minY)
(return false))
(doFor c controls
(+= c.y c.height)
(set c.visible !?(= c.y titleText?.y)))
(unless fake
(-= currentScroll 1)
(positionScrollBar))
true))
(method :Bool scrollUp []
(apply or (for _ (range SCROLL_LINES) (_scrollUp))))
(method positionScrollBar []
(let [scrollPercent (/ currentScroll scrollStepsPossible)
scrollBarY (+ scrollBarMin (* scrollPercent (- scrollBarMax scrollBarMin)))]
(set scrollBar.y scrollBarY)))
(method scrollToBottom []
(assert _useScrolling)
(while (_scrollDown)
null))
(method _nonUIControls []
(filter controls.members ->m ?(when (= -1 (.indexOf [xText upText downText titleText scrollBar] (cast m))) m)))
// titleText is sometimes not a FlxText
(prop &mut :FlxSprite titleText)
(method setTitleText [:String text]
(typeCase [titleText]
([:FlxText ttext]
(set ttext.text text))
(otherwise (throw "titleText is not a FlxText!"))))
(prop &mut :FlxText leftText)
(prop &mut :FlxText rightText)
(prop &mut :Array<FlxText> columnTexts [])
(prop &mut :FlxText xText)
// These are only for vertically scrolling SimpleWindows
(prop &mut :FlxText upText)
(prop &mut :FlxSprite downText)
(method columnTextStr [:Int column]
(if (= cameraColumn column) ">${column}<" "$column"))
(method makeScrollArrows []
(unless hasScrollArrows
// The left arrow control is not added until the window scrolls right
(let [ftext (new FlxText 0 height 0 "<-" textSize)]
(when fontPath
(set ftext.font fontPath))
(set ftext.cameras [controlCamera])
(-= ftext.y ftext.height)
(set ftext.color textColor)
(dictSet _colors ftext ftext.color)
(dictSet _actions ftext ->:Void _ (scrollLeft))
(set leftText ftext))
(when leftKey
(xHandler.registerItem "{${leftKey}}" scrollLeft true))
(let [ftext (new FlxText width height 0 "->" textSize)]
(when fontPath
(set ftext.font fontPath))
(set ftext.cameras [controlCamera])
(-= ftext.x ftext.width)
(-= ftext.y ftext.height)
(set ftext.color textColor)
(dictSet _colors ftext ftext.color)
(controls.add ftext)
(dictSet _actions ftext ->:Void _ (scrollRight))
(set rightText ftext))
(when rightKey
(xHandler.registerItem "{${rightKey}}" scrollRight true))
(refreshColumnTexts)
(set hasScrollArrows true))
// A column could be added while the same window is shown.
(refreshColumnTexts))
(method refreshColumnTexts []
(doFor i (range columnWidths.length)
(unless (> columnTexts.length i)
(let [ftext (new FlxText (fHalf width) height 0 (columnTextStr i) textSize)]
(when fontPath
(set ftext.font fontPath))
(set ftext.cameras [controlCamera])
(-= ftext.x (fHalf ftext.width))
(-= ftext.y ftext.height)
(set ftext.color textColor)
(dictSet _colors ftext ftext.color)
(dictSet _actions ftext
->:Void _
(until (= cameraColumn i)
(if (< cameraColumn i)
(scrollRight)
(scrollLeft))))
(controls.add ftext)
(columnTexts.push ftext)))
(let [ftext (nth columnTexts i)]
(set ftext.text (columnTextStr i))
(set ftext.x (+ (fHalf width) controlCamera.scroll.x))
(-= ftext.x (* (- (fHalf columnWidths.length) i) textSize 3))
(when (= cameraColumn i) (-= ftext.x .width (new FlxText 0 0 0 ">" textSize))))))
(prop :Map<FlxSprite,Action> _actions (new Map))
(prop :Map<FlxSprite,Action> _onSelectEvents (new Map))
(prop :Map<FlxSprite,Action> _onDeselectEvents (new Map))
(prop :Map<FlxSprite,Map<String,Action>> _altActions (new Map))
(prop :Map<FlxSprite,String> _tooltips (new Map))
(prop :Map<FlxSprite,FlxColor> _colors (new Map))
(prop &mut :Bool selectFirstInteractiveControl true)
(method &private makeText [:String text &opt :FlxColor color :Action onClick :Action onSelect :Action onDeselect :Bool noShortcut :FlxColor bgColor :Int margin :String tooltipText :Map<String,Action> altActions :FlxPoint overridePosition]
(let [:FlxSprite ftext
(if bgColor
(let [p (SpriteTools.textPlate text textSize (or margin 0) color bgColor null fontPath)]
(set p.x nextControlX)
(set p.y nextControlY)
p)
(let [t (new FlxText
(if overridePosition overridePosition.x nextControlX)
(if overridePosition overridePosition.y nextControlY)
0
text
textSize)]
(when fontPath
(set t.font fontPath))
t))]
(set ftext.color (or color textColor))
(dictSet _colors ftext ftext.color)
(addControl ftext ?overridePosition)
(when onSelect
(dictSet _onSelectEvents ftext onSelect))
(when onDeselect
(dictSet _onDeselectEvents ftext onDeselect))
(when onClick
(dictSet _actions ftext onClick)
(unless noShortcut
(keyHandler.registerItem text ->:Void (onClick ftext)))
(when (and selectFirstInteractiveControl (= -1 _selectedIndex))
(set selectedIndex (.indexOf (getColumnControls) ftext))))
(when altActions
(dictSet _altActions ftext altActions))
(when tooltipText
(dictSet _tooltips ftext tooltipText))
ftext))
(redefineWithObjectArgs makeText &public makeTextV2 [text])
(method disableControl [:FlxSprite control]
(_actions.remove control)
(_altActions.remove control)
(_onDeselectEvents.remove control)
(_onSelectEvents.remove control))
(method makeWrappedText [:String _text &opt :FlxColor color :Bool skipScrollingCheck]
(unless skipScrollingCheck (assert _useScrolling))
(let [text (new FlxText nextControlX nextControlY 0 _text textSize)
maxWidth (- _width nextControlX)]
(set text.color (or color textColor))
(cond
((> text.width maxWidth)
(let [tokens (_text.split " ")
nextLineTokens []]
(until (< text.width maxWidth)
(nextLineTokens.unshift (tokens.pop))
(set text.text (tokens.join " ")))
(addControl text)
(makeWrappedText (nextLineTokens.join " ") color skipScrollingCheck)))
(true
(addControl text)))))
(method makeMultilineText [:String text &opt :FlxColor color]
(doFor line (text.split "\n")
(makeWrappedText line color)))
// TODO make inputText
(prop &mut _shown false)
(method isShown [] _shown)
(prop &mut :kiss.List<Float> columnWidths [0.0])
(prop &mut cameraColumn 0)
(prop &mut hasScrollArrows false)
(method clearControls []
(set columnWidths [0.0])
(set columnTexts [])
(set hasScrollArrows false)
(_actions.clear)
(controls.clear)
(inputTexts.clear)
(keyHandler.clear)
(makeXControls)
(set nextControlX 0)
(set nextControlY 0)
(set nonLayoutControls [])
(addTitle))
(method :Void show [&opt :Int _cameraColumn]
(when _useScrolling
(measureVerticalScrolling)
(when (= 0 scrollStepsPossible)
(controls.remove upText)
(controls.remove downText)
(controls.remove scrollBar)))
(when (and _cameraColumn !(= cameraColumn _cameraColumn))
(assert (<= 0 _cameraColumn (- columnWidths.length 1)) "Tried to show out-of-bounds camera column ${_cameraColumn} of ${columnWidths.length}")
(while (> cameraColumn _cameraColumn)
(scrollLeft))
(while (< cameraColumn _cameraColumn)
(scrollRight)))
(unless _shown
(FlxG.cameras.add controlCamera false)
(FlxG.state.add this)
(FlxG.state.add controls)
(when selectionMarker
(set selectionMarker.visible !(= -1 _selectedIndex))
(set selectionMarker.cameras [controlCamera])
(FlxG.state.add selectionMarker))
(windowStack.push this)
(keyHandler.start)
(xHandler.start)
(FlxMouseEvent.globalManager.add this)
(FlxMouseEvent.globalManager.setMouseMoveCallback this ->_
(set mouseMode true))
(set _shown true)))
(method :Void hide []
(when _shown
(FlxMouseEvent.globalManager.remove this)
(FlxG.cameras.remove controlCamera false)
(FlxG.state.remove this true)
(FlxG.state.remove controls true)
(hideTooltipText)
(when (rightClickMenu?.isShown) (rightClickMenu.hide))
(when selectionMarker
(FlxG.state.remove selectionMarker true))
(windowStack.remove this)
(keyHandler.cancel)
(xHandler.cancel)
(set _shown false)))
(method :Void hideOrHideMenu []
(if (rightClickMenu?.isShown)
(rightClickMenu.hide)
(hide)))
(function getHighlighted [:FlxColor color &opt :Float amount]
(unless amount (set amount 0.2))
(cond ((> color.lightness amount)
(color.getDarkened amount))
(true
(color.getLightened amount))))
(prop &mut :Bool mouseMode false)
(prop &mut otherIsSelected false)
(method &override update [:Float elapsed]
(super.update elapsed)
(set justPressedUIButton false)
(set otherIsSelected false)
(localVar columnControls (getColumnControls))
(when (= (last windowStack) this)
(when keyboardEnabled
(unless (apply or (for textBox inputTexts.members textBox.hasFocus))
(keyHandler.update)))
(xHandler.update)
// Scroll wheel scroll up/down
(when _useScrolling
(let [scrollAmount FlxG.mouse.wheel
scrollFunc (if (> 0 scrollAmount) _scrollDown _scrollUp)]
(doFor _ (range (Std.int (Math.abs scrollAmount)))
(scrollFunc))))
// Scroll bar drag up/down
(when draggingScrollBar
(let [scrollPercent (/ (- scrollBar.y scrollBarMin) (- scrollBarMax scrollBarMin))
currentScrollTarget (Math.round (* scrollStepsPossible scrollPercent))]
(let [scrollFunc (if (> 0 (- currentScrollTarget currentScroll)) _scrollUp _scrollDown)]
(until (= currentScroll currentScrollTarget) (scrollFunc)))))
// Figure out whether to use mouse input or key/gamepad input for ui navigation
(when justPressedUIButton
(set mouseMode false))
// Handle mouse input
(when mouseMode
(let [mousePos (FlxG.mouse.getScreenPosition controlCamera)]
// Click outside of right-click menu
(when (and isRightClickMenu (or FlxG.mouse.justPressed FlxG.mouse.justPressedRight) !(.containsPoint (getScreenBounds) (FlxG.mouse.getScreenPosition)))
(hide))
// Click and hover on clickable text entries
(controls.forEach ->text
(let [onClick (dictGet _actions text)
:Map<String,Action> altActions (or (dictGet _altActions text) (new Map<String,Action>))
&mut tooltipText (dictGet _tooltips text)]
(when (or onClick (< 0 (count altActions)) tooltipText)
(let [color (dictGet _colors text)]
(if (and !otherIsSelected (.containsPoint (text.getScreenBounds controlCamera) mousePos))
{
(cond
((and FlxG.mouse.justPressed onClick)
(onClick text))
((and FlxG.mouse.justPressedRight (< 0 (count altActions)))
(showRightClickMenu text altActions))
((or tooltipText (< 0 (count altActions)))
(showTooltipText text (or tooltipText "") altActions))
(true
(hideTooltipText)))
(set otherIsSelected true)
(set text.color (getHighlighted (dictGet _colors text)))
(set selectedIndex (columnControls.indexOf text))
}
(set text.color (dictGet _colors text)))))))
// Click on text boxes to focus them
(inputTexts.forEach ->:Void text
(when FlxG.mouse.justPressed
(when (.containsPoint (text.getScreenBounds controlCamera) mousePos)
(set otherIsSelected true)
(set text.caretIndex (text.getCaretIndex controlCamera))
(if (columnControls.contains text)
(set selectedIndex (columnControls.indexOf text))
(inputTexts.forEach ->:Void t
(set t.hasFocus (= t text)))))))
(when scrollBar
(if (.containsPoint (scrollBar.getScreenBounds controlCamera) mousePos)
(set scrollBar.color (getHighlighted (dictGet _colors scrollBar)))
(set scrollBar.color (dictGet _colors scrollBar))))
(unless otherIsSelected
(set selectedIndex -1)
(hideTooltipText)
// Click anywhere else to take focus away from text boxes
(when FlxG.mouse.justPressed
(inputTexts.forEach ->text (set text.hasFocus false))))))))
(function &private :SimpleWindow notify [:String message
:Void->Void onDismiss
&opt :FlxColor bgColor
:FlxColor titleColor
:FlxColor choiceColor
:Float percentWidth
:Float percentHeight
:Bool xButton
:String xKey
:String enterKey
:String screenReaderAudioFolder]
(promptForChoice
message
["OK"]
->_ (onDismiss)
bgColor
titleColor
choiceColor
percentWidth
percentHeight
xButton
xKey
null
null
null
null
enterKey
onDismiss
false
true
screenReaderAudioFolder))
(redefineWithObjectArgs notify &public notifyV2 [message onDismiss])
(function &private :SimpleWindow promptForChoice <>[T] [:String prompt
:Array<T> choices
:T->Void onChoice
&opt :FlxColor bgColor
:FlxColor titleColor
:FlxColor choiceColor
:Float percentWidth
:Float percentHeight
:Bool xButton
:String xKey
:String leftKey
:String rightKey
:String upKey
:String downKey
:String enterKey
:ShortcutAction onClose
:Bool noShortcuts
:Bool wrapPrompt
:String screenReaderAudioFolder
:Array<String> tooltipTexts]
(let [window (new SimpleWindow (unless wrapPrompt prompt) bgColor titleColor percentWidth percentHeight xButton xKey leftKey rightKey upKey downKey enterKey onClose defaultSelectionMarker screenReaderAudioFolder)
choiceColor (or choiceColor titleColor FlxColor.WHITE)]
(when wrapPrompt
(window.makeWrappedText prompt titleColor true))
(doFor [idx choice] (enumerate choices)
(window.makeTextV2 (Std.string choice) (object color choiceColor
onClick (when (Std.string choice)
->:Void s {
(window.hide)
(onChoice choice)
})
noShortcut noShortcuts
tooltipText (when tooltipTexts (nth tooltipTexts idx)))))
(window.show)
window))
(redefineWithObjectArgs promptForChoice &public promptForChoiceV2 [prompt choices onChoice])
(function &private :SimpleWindow promptForString [:String prompt
:String->Void onChoice
&opt :FlxColor bgColor
:FlxColor titleColor
:FlxColor submitColor
:Float percentWidth
:Float percentHeight
:Bool xButton
:String xKey
:String leftKey
:String rightKey
:String upKey
:String downKey
:String enterKey
:ShortcutAction onClose
:Bool wrapPrompt]
(let [window (new SimpleWindow (unless wrapPrompt prompt) bgColor titleColor percentWidth percentHeight xButton xKey leftKey rightKey upKey downKey enterKey onClose)
buttonColor (or submitColor FlxColor.WHITE)
inputText (new KissInputText 0 0 FlxG.width "" textSize true)]
(when wrapPrompt
(window.makeWrappedText prompt titleColor true))
(window.addControl inputText)
(window.makeText "{enter} Submit" buttonColor
->:Void s {
(window.hide)
(onChoice inputText.text)
})
(window.show)
window))
(redefineWithObjectArgs promptForString &public promptForStringV2 [prompt onChoice])
(function &private :SimpleWindow promptForColor <>[T] [:String prompt
:FlxColor->Void onChoice
&opt :Array<FlxColor> choices
:FlxColor currentColor
:Bool allowAlpha
:FlxColor bgColor
:FlxColor titleColor
:Float percentWidth
:Float percentHeight
:Bool xButton
:String xKey
:String leftKey
:String rightKey
:String upKey
:String downKey
:String enterKey
:ShortcutAction onClose
:Bool noShortcuts
:Bool wrapPrompt
:String screenReaderAudioFolder]
(let [window (new SimpleWindow (unless wrapPrompt prompt) bgColor titleColor percentWidth percentHeight xButton xKey leftKey rightKey upKey downKey enterKey onClose defaultSelectionMarker screenReaderAudioFolder)]
(when wrapPrompt
(window.makeWrappedText prompt titleColor true))
(unless choices (set choices (collect FlxColor.colorLookup)))
(unless currentColor (set currentColor (first choices)))
(localFunction recursiveCall [:FlxColor newCurrentColor]
(window.hide)
(promptForColor prompt onChoice choices newCurrentColor allowAlpha bgColor titleColor percentWidth percentHeight xButton xKey leftKey rightKey upKey downKey enterKey onClose noShortcuts wrapPrompt screenReaderAudioFolder))
(window.makeTextV2
" "
(object
bgColor currentColor
onClick ->:Void s {
(window.hide)
(onChoice currentColor)
}
noShortcut noShortcuts))
(var COLOR_STEP 0.1)
(window.makeTextV2 "Lighter" (object onClick ->:Void s (recursiveCall (currentColor.getLightened COLOR_STEP))))
(window.makeTextV2 "Darker" (object onClick ->:Void s (recursiveCall (currentColor.getDarkened COLOR_STEP))))
(window.makeTextV2 "Red++" (object onClick ->:Void s (recursiveCall {(+= currentColor.redFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Red--" (object onClick ->:Void s (recursiveCall {(-= currentColor.redFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Green++" (object onClick ->:Void s (recursiveCall {(+= currentColor.greenFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Green--" (object onClick ->:Void s (recursiveCall {(-= currentColor.greenFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Blue++" (object onClick ->:Void s (recursiveCall {(+= currentColor.blueFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Blue--" (object onClick ->:Void s (recursiveCall {(-= currentColor.blueFloat COLOR_STEP) currentColor})))
(when allowAlpha
(window.makeTextV2 "Alpha++" (object onClick ->:Void s (recursiveCall {(+= currentColor.alphaFloat COLOR_STEP) currentColor})))
(window.makeTextV2 "Alpha--" (object onClick ->:Void s (recursiveCall {(-= currentColor.alphaFloat COLOR_STEP) currentColor}))))
(doFor choice choices
(window.makeTextV2
" "
(object
bgColor choice
onClick ->:Void s (recursiveCall choice)
noShortcut noShortcuts)))
(window.show)
window))
(redefineWithObjectArgs promptForColor &public promptForColorV2 [prompt onChoice])
(method scrollLeft []
(when (> cameraColumn 0)
(-= cameraColumn 1)
(when (= cameraColumn 0)
(controls.remove leftText true))
(controls.add rightText)
(let [scrollAmount (nth columnWidths cameraColumn)]
(-= controlCamera.scroll.x scrollAmount)
(when titleText
(-= titleText.x scrollAmount))
(-= leftText.x scrollAmount)
(-= rightText.x scrollAmount)
(doFor columnText columnTexts
(-= columnText.x scrollAmount))
(when xText
(-= xText.x scrollAmount)))
(refreshColumnTexts)))
(method scrollRight []
(when (< cameraColumn (- columnWidths.length 1 ))
(let [scrollAmount (nth columnWidths cameraColumn)]
(+= controlCamera.scroll.x scrollAmount)
(when titleText
(+= titleText.x scrollAmount))
(+= leftText.x scrollAmount)
(+= rightText.x scrollAmount)
(doFor columnText columnTexts
(+= columnText.x scrollAmount))
(when xText
(+= xText.x scrollAmount)))
(+= cameraColumn 1)
(when (< (apply + (columnWidths.slice cameraColumn)) width)
(controls.remove rightText true))
(controls.add leftText)
(refreshColumnTexts)))
// Irreversibly disable the window's buttons (for when you're going to hide it in the next frame)
(method clearActions []
(_actions.clear))
(prop &mut :Null<Int> gamepadId null)
(method enableGamepadInput [:Bool addDefaultUIInputs &opt :Map<FlxGamepadInputID,String> uiKeyMappings :Map<FlxGamepadInputID,String> otherKeyMappings :Int gamepadId]
(unless gamepadId (set gamepadId FlxInputDeviceID.ALL))
(set this.gamepadId gamepadId)
(unless uiKeyMappings (set uiKeyMappings (new Map)))
(localVar DEFAULT_UI_INPUTS [
=>xKey [B]
=>leftKey [DPAD_LEFT LEFT_STICK_DIGITAL_LEFT]
=>rightKey [DPAD_RIGHT LEFT_STICK_DIGITAL_RIGHT]
=>upKey [DPAD_UP LEFT_STICK_DIGITAL_UP]
=>downKey [DPAD_DOWN LEFT_STICK_DIGITAL_DOWN]
=>enterKey [A START]
])
(when addDefaultUIInputs
(doFor key [xKey leftKey rightKey upKey downKey enterKey]
(whenLet [key key buttons (dictGet DEFAULT_UI_INPUTS key)]
(doFor button buttons
(unless (uiKeyMappings.exists button)
(dictSet uiKeyMappings button key))))))
(xHandler.enableGamepadInput uiKeyMappings gamepadId)
(when otherKeyMappings
(keyHandler.enableGamepadInput otherKeyMappings gamepadId))
this)
(var &mut :String lastTooltipText "")
(var &mut :FlxSprite tooltipSprite null)
(var :FlxPoint tempPoint (new FlxPoint))
(method :Void showTooltipText [:FlxSprite control :String text :Map<String,Action> altActions]
(let [numAltActions (count altActions)
mousePos (FlxG.mouse.getWorldPosition controlCamera tempPoint)
widthAllowed (- width (- mousePos.x controlCamera.scroll.x))
heightAllowed (- height (- mousePos.y controlCamera.scroll.y))]
// With alt actions, append the number of them to the tooltip
(when (< 0 numAltActions)
(when text
(+= text "\n\n"))
(+= text "RMB: $numAltActions more option")
(when (< 1 numAltActions)
(+= text "s")))
(if (= text lastTooltipText)
// Tooltip sprite already exists, just move it
{
(set tooltipSprite.x mousePos.x)
(set tooltipSprite.y mousePos.y)
}
{
(when tooltipSprite
(tooltipSprite.kill)
(tooltipSprite.destroy))
(set tooltipSprite (SpriteTools.textPlateV2 text textSize (/ textSize 2) (objectWith [width (- width (- control.x controlCamera.scroll.x))] textColor bgColor null fontPath)))
(set tooltipSprite.x mousePos.x)
(set tooltipSprite.y mousePos.y)
(flixel.util.FlxSpriteUtil.drawRect tooltipSprite 0 0 tooltipSprite.width tooltipSprite.height FlxColor.TRANSPARENT (object color textColor))
(set lastTooltipText text)
})
(when (< widthAllowed tooltipSprite.width)
(-= tooltipSprite.x (- tooltipSprite.width widthAllowed)))
(when (< heightAllowed tooltipSprite.height)
(-= tooltipSprite.y (- tooltipSprite.height heightAllowed)))
(set tooltipSprite.cameras [controlCamera])
(FlxG.state.add tooltipSprite)))
(method :Void hideTooltipText []
(set lastTooltipText "")
(when tooltipSprite
(FlxG.state.remove tooltipSprite true)
(tooltipSprite.destroy)))
(method :Void moveTo [:FlxPoint position]
(set x position.x)
(set y position.y)
(set controlCamera.x (+ camera.x position.x (- camera.scroll.x)))
(set controlCamera.y (+ camera.y position.y (- camera.scroll.y))))
(method :Void resize [:Int width :Int height]
(makeGraphic
width
height
bgColor
true)
(flixel.util.FlxSpriteUtil.drawRect this 0 0 width height FlxColor.TRANSPARENT (object color textColor))
(set controlCamera.width width)
(set controlCamera.height height)
(when xText
(set xText.x width)
(-= xText.x xText.width)))
(prop &mut :SimpleWindow rightClickMenu)
(prop &mut isRightClickMenu false)
(method :Void showRightClickMenu [:FlxSprite control :Map<String,Action> altActions]
(hideTooltipText)
// alt action keys can start with numbers and be sorted lexicographically,
// then the numbers and intervening whitespace will be stripped out
(let [sortedKeys (sort (collect (altActions.keys)))]
(let [mousePos (FlxG.mouse.getWorldPosition controlCamera tempPoint)
keysWithoutNumber
(for key sortedKeys
(let [chars (key.split "")]
(while (Strings.isDigits (first chars))
(chars.shift))
(StringTools.trim (chars.join ""))))
keysWithoutNumberMap
(for [keyWithoutNumber key] (zip keysWithoutNumber sortedKeys)
=>keyWithoutNumber key)
choiceWindow
(promptForChoiceV2
""
keysWithoutNumber
->choice
((dictGet altActions (dictGet keysWithoutNumberMap choice)) control)
(objectWith [choiceColor textColor xButton true] bgColor))]
(set choiceWindow.isRightClickMenu true)
(set choiceWindow.mouseMode mouseMode)
(set rightClickMenu choiceWindow)
// set up choiceWindow with position where it should be etc
(set choiceWindow.camera controlCamera)
(let [widthNeeded (+ (or choiceWindow.selectionMarker?.width 0) (* textSize 2) (or choiceWindow.xText?.width 0) (apply max (for control choiceWindow.controls control.width)))
widthAvail (- width (- mousePos.x controlCamera.scroll.x))
heightNeeded (Std.int choiceWindow.nextControlY)
heightAvail (- height (- mousePos.y controlCamera.scroll.y))]
(when (< widthAvail widthNeeded)
(-= mousePos.x (- widthNeeded widthAvail)))
(when (< heightAvail heightNeeded)
(-= mousePos.y (- heightNeeded heightAvail)))
(choiceWindow.moveTo mousePos)
(choiceWindow.resize
widthNeeded
(Std.int choiceWindow.nextControlY))))))
(#when sys
(function filePicker [:String initialDir :ConstructorArgs args :String->Void resolve &opt :FileChoiceType choiceType]
(unless choiceType (set choiceType FileOnly))
(let [window (SimpleWindow.create args)
dirParts (initialDir.split "/")
&mut tab ""]
(localFunction recurse [newDir]
(window.hide)
(filePicker newDir args resolve choiceType))
(when (> dirParts.length 1)
(window.makeTextV2 "../"
(object
onClick
->_ {
(dirParts.pop)
(recurse (dirParts.join "/"))
}))
(+= tab " "))
(window.makeTextV2 "${tab}${initialDir}/"
(object altActions
(if (choiceType.match FileOnly)
(new Map)
[
=>"Choose"
->_ {
(window.hide)
(resolve initialDir)
}
])))
(+= tab " ")
(localVar contents (sys.FileSystem.readDirectory initialDir))
(contents.sort Reflect.compare)
(doFor path contents
(if (sys.FileSystem.isDirectory (joinPath initialDir path))
{
(window.makeTextV2 "${tab}${path}/"
(object
onClick
->_ (recurse (joinPath initialDir path))
altActions
(if (choiceType.match FileOnly)
(new Map)
[
=>"choose"
->_ {
(window.hide)
(resolve (joinPath initialDir path))
}
])))
}
{
(window.makeTextV2 "${tab}$path"
(unless (choiceType.match FolderOnly)
(object onClick ->_ {
(window.hide)
(resolve (joinPath initialDir path))
})))
}))
(window.show)))
(function hankStoryWindow [:String file :ConstructorArgs args &opt :Map<String,HankChoiceTagEvent> onChoiceTags]
(whenLet [story (try (Story.FromFile file)
(catch [e] (return (notify "Failed to parse story from $file: $e" ->:Void {}))))
window (SimpleWindow.create args)]
(localFunction :Void showNextFrame []
(let [frame (try (story.nextFrame)
(catch [e]
(window.hide)
(notify "Hank runtime error: $e" ->:Void {})
(return)))]
(case frame
(Finished
(window.makeTextV2 "Done"
(object
onClick ->_ (window.hide))))
((HasText text)
(window.makeTextV2 text)
(showNextFrame))
((HasChoices choices tags)
(doFor [idx choice] (enumerate choices)
(window.makeTextV2 "[$(+ idx 1)] $choice"
(object onClick
->_ {
// Call events for tags
(doFor tag (nth tags idx)
(when (onChoiceTags?.exists tag)
((dictGet onChoiceTags tag) choice)))
(try (story.choose idx)
(catch [e]
(window.hide)
(notify "Hank runtime error: $e" ->:Void {}) ))
(window.clearControls)
(showNextFrame)
}))))
(never null))))
(showNextFrame)
window)))
(function :SimpleWindow textSettingsWindow [:ConstructorArgs args]
(set args.xButton true)
(let [hasFontOptions (<= 2 (count fonts))
window (SimpleWindow.create args)]
(localFunction :Void rebuild []
(window.clearControls)
(window.makeText "")
(window.toggleRowLayout)
(window.makeText "Text Size: ")
(window.makeTextV2 "-" (object onClick ->_ {
--textSize
(set textSize (max textSize minTextSize))
(rebuild)
}))
(window.makeText " $textSize ")
(window.makeTextV2 "+" (object onClick ->_ {
++textSize
(set textSize (min textSize maxTextSize))
(rebuild)
}))
(window.toggleRowLayout)
(when (< 1 (count fonts))
(window.makeText "Fonts:")
(localFunction makeFontChoice [font]
(let [path (dictGet fonts font)
selected (= fontPath path)]
(window.makeTextV2 "$(if selected "*" " ")$font"
(object onClick ->_ {
(set fontPath path)
(rebuild)
}))))
(let [fontsInOrder (sort (collect (fonts.keys)))]
// 'Default' skips alphabetization:
(when (fontsInOrder.remove "Default")
(makeFontChoice "Default"))
(doFor font fontsInOrder
(makeFontChoice font))))
// TODO could add screen reader on/off here?
)
(rebuild)
window))