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

556 lines
22 KiB
Plaintext

(loadFrom "kiss-tools" "src/kiss_tools/RefactorUtil.kiss")
// All windows share the same text size
(var &mut textSize 16)
(var :kiss.List<SimpleWindow> windowStack [])
(var &mut :flixel.FlxCamera defaultCamera null)
(prop :FlxCamera controlCamera)
(prop &mut keyboardEnabled true)
(prop &mut :Int _selectedIndex -1)
(prop :Int selectedIndex (property get set))
(method get_selectedIndex [] _selectedIndex)
(method set_selectedIndex [value]
(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) (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)))
// TODO play screenreader of the text
(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))
(defNew [&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]
[: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)
:Bool xButton ?_xButton
:String xKey _xKey
:String leftKey _leftKey
:String rightKey _rightKey
:String upKey _upKey
:String downKey _downKey
:String enterKey _enterKey
: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)))]
(assert FlxG.camera "SimpleWindow.new() must be called in or after create()")
(super 0 0)
(when defaultCamera (set this.cameras [defaultCamera]))
(makeGraphic
_width
_height
(or bgColor FlxColor.BLACK))
(screenCenter)
(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)
(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)))
(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)
})
(set xHandler.cancelKey null)
(set xHandler.onBadKey ->:Void [key context] 0)
(set xHandler.onSelectItem
->:Void [:ShortcutAction a] {
(a)
(xHandler.start)
})
(defAndCall method makeXControls
(let [closeAction ->:Void {(hide)(when onClose (onClose))}]
(when xButton
(let [ftext (new FlxText width 0 0 "X" textSize)]
(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 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]
(when c (columnControls.remove c)))
(doFor c columnTexts
(when c (columnControls.remove c)))
(doFor c nonLayoutControls
(when c (columnControls.remove c)))
columnControls))
(method addControl [:FlxSprite control &opt :Bool ignoreLayout]
(when ?ignoreLayout
(nonLayoutControls.push control))
(when (Std.isOfType control KissInputText)
(inputTexts.add (cast control KissInputText)))
(set control.cameras [controlCamera])
(controls.add control)
(unless ?ignoreLayout
(set control.x nextControlX)
(set control.y nextControlY)
(+= nextControlY control.height)
// TODO controls that aren't the same height as text will be able to vertically overflow
(unless _useScrolling
(let [columnControls (getColumnControls)]
(setNth columnWidths -1 (max (+ control.width textSize) (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)
(method enableVerticalScrolling [&opt :String upKey :String downKey]
(set _useScrolling 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)
// 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))))
(method :Bool _scrollDown []
(let [:kiss.List<FlxSprite> controls (_nonUIControls)]
(when (< .y (last controls) _height)
(return false))
(doFor c controls
(-= c.y c.height)
(set c.visible !?(= c.y titleText?.y)))
true))
(method :Bool _scrollUp []
(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)))
true))
(method :Bool scrollUp []
(apply or (for _ (range SCROLL_LINES) (_scrollUp))))
(method scrollToBottom []
(assert _useScrolling)
(while (_scrollDown)
null))
(method _nonUIControls []
(filter controls.members ->m ?(when (= -1 (.indexOf [xText upText downText titleText] (cast m))) m)))
(prop &mut :FlxText titleText)
(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)]
(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)]
(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)]
(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,FlxColor> _colors (new Map))
(method makeText [:String text &opt :FlxColor color :Action onClick :Action onSelect :Action onDeselect :Bool noShortcut]
(let [ftext (new FlxText nextControlX nextControlY 0 text textSize)]
(set ftext.color (or color textColor))
(dictSet _colors ftext ftext.color)
(addControl ftext)
(when onClick
(dictSet _actions ftext onClick)
(unless noShortcut
(keyHandler.registerItem text ->:Void (onClick ftext))))
(when onSelect
(dictSet _onSelectEvents ftext onSelect))
(when onDeselect
(dictSet _onDeselectEvents ftext onDeselect))
ftext))
(method makeWrappedText [:String _text &opt :FlxColor color]
(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 " "))))
(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 [])
(set titleText (makeText title titleColor)))
(method :Void show [&opt :Int _cameraColumn]
(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)
(windowStack.push this)
(keyHandler.start)
(xHandler.start)
(set _shown true)))
(method :Void hide []
(when _shown
(FlxG.cameras.remove controlCamera false)
(FlxG.state.remove this true)
(FlxG.state.remove controls true)
(windowStack.remove this)
(keyHandler.cancel)
(xHandler.cancel)
(set _shown false)))
(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 otherIsSelected false)
(method &override update [:Float elapsed]
(super.update elapsed)
(set otherIsSelected false)
(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
// TODO move all controls other than xButton and scrollbar. Clamp movement by top and bottom of all controls
null)
// Handle mouse input
(let [mousePos (FlxG.mouse.getScreenPosition controlCamera)]
// Click and hover on clickable text entries
(controls.forEach ->text
(whenLet [onClick (dictGet _actions text)]
(let [color (dictGet _colors text)]
(when (and !otherIsSelected (.containsPoint (text.getScreenBounds controlCamera) mousePos))
(when FlxG.mouse.justPressed
(onClick text))
(set otherIsSelected true)
(set selectedIndex (columnControls.indexOf text))))))
// Click on text boxes to focus them
(inputTexts.forEach ->text
(when FlxG.mouse.justPressed
(when (.containsPoint (text.getScreenBounds controlCamera) mousePos)
(set otherIsSelected true)
(set text.caretIndex (text.getCaretIndex controlCamera))
(set selectedIndex (columnControls.indexOf text)))))
(unless otherIsSelected
(set selectedIndex -1)
// Click anywhere else to take focus away from text boxes
(when FlxG.mouse.justPressed
(inputTexts.forEach ->text (set text.hasFocus false)))))))
(function :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]
(let [window (new SimpleWindow prompt bgColor titleColor percentWidth percentHeight xButton xKey leftKey rightKey upKey downKey enterKey onClose)
choiceColor (or choiceColor titleColor FlxColor.WHITE)]
(doFor choice choices
(window.makeText (Std.string choice) choiceColor
->:Void s {
(window.hide)
(onChoice choice)
}
noShortcuts))
(window.show)
window))
(function :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]
(let [window (new SimpleWindow 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)]
(window.addControl inputText)
(window.makeText "{enter} Submit" buttonColor
->:Void s {
(window.hide)
(onChoice inputText.text)
})
(window.show)
window))
(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))
(method enableGamepadInput [:Bool addDefaultUIInputs &opt :Map<FlxGamepadInputID,String> uiKeyMappings :Map<FlxGamepadInputID,String> otherKeyMappings :Int 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
(dictSet uiKeyMappings button key)))))
(xHandler.enableGamepadInput uiKeyMappings gamepadId)
(when otherKeyMappings
(keyHandler.enableGamepadInput otherKeyMappings gamepadId))
this)