Permalink
Browse files

[feature] stdlib: added an experimental UI library

Rescued this interesting proposal for an UI library. Although it is very
experimental, I think it's worth of being on master, as a proposal towards a
better UI library. Note: most of the work due to David.
  • Loading branch information...
1 parent 7409d79 commit c252d10c3dcbe000dc5ab82741120e42222095ee François-Régis Sinot committed Oct 12, 2011
View
133 stdlib/elvis/button.opa
@@ -0,0 +1,133 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Buttons
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Simple clickable}
+ *
+ * Native button.
+ */
+
+/**
+ * {1 Theming}
+ *
+ * The button always has classes "mlstate" "elvis" "button"
+ * During a click, it also has class "down", otherwise it has class "up"
+ * When enabled, it has class "enabled", otherwise it has class "disabled"
+ */
+
+type EButton.options = {
+ content: xhtml
+ is_enabled: bool
+}
+
+type EButton.sources = {
+ chosen: Event.source(void)
+}
+@abstract type EButton.implementation = {
+ dom: dom
+ state_enabled: Client.reference(bool)
+}
+
+type EButton.elvis = Elvis.elvis(EButton.sources, EButton.implementation)
+
+EButton =
+{{
+/**
+ * {1 Constructors}
+ */
+ simple(content:xhtml): EButton.elvis =
+ make({is_enabled = true
+ content = content})
+
+ make(options:EButton.options): EButton.elvis =
+ (
+ id = "ebutton_{Random.string(32)}"
+ dom = Dom.select_id(id)
+ chosen_net = Network.empty()
+ state_enabled = Client_reference.create(options.is_enabled)
+ display(theme) =
+ (
+ mouse_changed(up) =
+ (
+ if Client_reference.get(state_enabled) then
+ dom = Dom.resolve(dom)
+ if up then
+ do Dom.remove_class(dom, class_down)
+ do Dom.add_class(dom, class_up)
+ void
+ else
+ do Dom.remove_class(dom, class_up)
+ do Dom.add_class(dom, class_down)
+ void
+ )
+ theme_classes = Elvis.Theme.get_classes(theme)
+ xhtml = <button id={id}
+ class="{theme_classes} elvis mlstate button {class_up} {if Client_reference.get(state_enabled) then class_enabled else class_disabled}"
+ onclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, chosen_net) else void}
+ onmouseup={_ -> mouse_changed({true})}
+ onmousedown={_ -> mouse_changed({false})}
+ >{
+ options.content
+ }</button>
+ dom = Dom.of_xhtml(xhtml)
+ ~{xhtml dom}
+ )
+ implem = ({
+ ~dom
+ ~state_enabled
+ })
+ sources = {
+ chosen = (chosen_net)
+ }
+ Elvis.make(sources, implem, display)
+ )
+
+/**
+ * {1 Accessors}
+ */
+ set_enabled(button: EButton.elvis, enabled: bool): void =
+ (
+ implem = (Elvis.implem(button))
+ dom = Dom.resolve(implem.dom)
+ state_enabled = implem.state_enabled
+ do if enabled != Client_reference.get(state_enabled) then
+ if enabled then
+ do Dom.remove_class(dom, class_disabled)
+ do Dom.add_class(dom, class_enabled)
+ void
+ else
+ do Dom.remove_class(dom, class_enabled)
+ do Dom.add_class(dom, class_disabled)
+ void
+ Client_reference.set(state_enabled, enabled)
+ )
+
+ @private class_enabled = "enabled"
+ @private class_disabled= "disabled"
+ @private class_up = "up"
+ @private class_down = "down"
+}}
View
147 stdlib/elvis/clickable.opa
@@ -0,0 +1,147 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Clickables
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Simple clickable}
+ *
+ * Wrap an elvis as something clickable.
+ */
+
+/**
+ * {1 Theming}
+ *
+ * The clickable always has classes "mlstate" "elvis" "clickable"
+ * During a click, it also has class "down", otherwise it has class "up"
+ * When enabled, it has class "enabled", otherwise it has class "disabled"
+ */
+
+type EClickable.options = {
+ content: Elvis.elvis(Elvis.masked, Elvis.masked)
+ is_enabled: bool
+}
+
+type EClickable.sources = {
+ chosen: Event.source(void)
+ //unfocused:Event.source(void)
+ dbclick: Event.source(void)
+}
+@abstract type EClickable.implementation = {
+ dom: dom
+ state_enabled: Client.reference(bool)
+}
+
+type EClickable.elvis = Elvis.elvis(EClickable.sources, EClickable.implementation)
+
+EClickable =
+{{
+/**
+ * {1 Constructors}
+ */
+ simple(content:xhtml): EClickable.elvis =
+ make({is_enabled = true
+ content = Elvis.pack(ELabel.simple(content))})
+
+ make(options:EClickable.options): EClickable.elvis =
+ (
+ id = "eclickable_{Random.string(32)}"
+ dom = Dom.select_id(id)
+ chosen_net = Network.empty()
+ dbclick_net = Network.empty()
+ //unfocused_net = Network.empty()
+ state_enabled = Client_reference.create(options.is_enabled)
+ display(theme) =
+ (
+ mouse_changed(up) =
+ (
+ if Client_reference.get(state_enabled) then
+ dom = Dom.resolve(dom)
+ if up then
+ do Dom.remove_class(dom, class_down)
+ do Dom.add_class(dom, class_up)
+ void
+ else
+ do Dom.remove_class(dom, class_up)
+ do Dom.add_class(dom, class_down)
+ void
+ )
+ theme_classes = Elvis.Theme.get_classes(theme)
+ xhtml = <div id={id}
+ class="{theme_classes} elvis mlstate clickable {class_up} {if Client_reference.get(state_enabled) then class_enabled else class_disabled}"
+ onclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, chosen_net) else void}
+ ondblclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, dbclick_net) else void}
+ //onfocusout={_ -> Network.broadcast({}, unfocused_net)}
+ onmouseup={_ -> mouse_changed({true})}
+ onmousedown={_ -> mouse_changed({false})}>
+ <div class="{theme_classes} elvis mlstate clickable_content">{
+ Elvis.for_display_in_theme(options.content, theme)
+ }</div></div>
+ dom = Dom.of_xhtml(xhtml)
+ ~{xhtml dom}
+ )
+ implem = ({
+ ~dom
+ ~state_enabled
+ })
+ sources = {
+ chosen = (chosen_net)
+ dbclick = (dbclick_net)
+ //unfocused = (unfocused_net)
+ }
+ Elvis.make(sources, implem, display)
+ )
+
+ default_options =
+ {
+ content = ELabel.simple(<>Nothing to see</>)
+ is_enabled = {true}
+ }
+/**
+ * {1 Accessors}
+ */
+ set_enabled(clickable: EClickable.elvis, enabled: bool): void =
+ (
+ implem = (Elvis.implem(clickable))
+ dom = Dom.resolve(implem.dom)
+ state_enabled = implem.state_enabled
+ do if enabled != Client_reference.get(state_enabled) then
+ if enabled then
+ do Dom.remove_class(dom, class_disabled)
+ do Dom.add_class(dom, class_enabled)
+ void
+ else
+ do Dom.remove_class(dom, class_enabled)
+ do Dom.add_class(dom, class_disabled)
+ void
+ Client_reference.set(state_enabled, enabled)
+ )
+
+ @private class_enabled = "enabled"
+ @private class_disabled= "disabled"
+ @private class_up = "up"
+ @private class_down = "down"
+}}
+
View
131 stdlib/elvis/completion.opa
@@ -0,0 +1,131 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Completions
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * An input with auto-completion.
+ *
+ * When users type, a popup menu appears, prompting to choose one value in the menu. Only these values can be accepted (note that the popup menu can
+ * be programmed to display the value currently written by the user). Once the value is accepted, it is displayed as a button and the user can restart
+ * typing another value, etc.
+ */
+
+
+type ECompletion.options('value) =
+{
+ welcome_text: string
+ accept_multiple_entries: bool
+ suggest_completions: string -> list('value)
+ display_suggestion: 'value -> xhtml
+ display_choice: 'value -> xhtml
+ text_suggestion: 'value -> string
+}
+
+type ECompletion.sources('value) =
+{
+ added_value: Event.source({new:'value all:list('value)})
+ //TODO: added_value
+ //TODO: changed_value
+}
+
+@abstract type ECompletion.implem('value) = {}
+
+type ECompletion.elvis('value) = Elvis.elvis(ECompletion.sources('value), ECompletion.implem('value))
+
+ECompletion =
+{{
+ make(options: ECompletion.options('value)): ECompletion.elvis('value) =
+ (
+ //Setup events
+ added_value_net = Network.empty()
+
+ //Setup UI
+ elvis_input = EInput.simple()
+ elvis_accepted_list = EList.empty()
+ elvis_accepted_panel = EPanel.make({EPanel.default_options with
+ children = [Elvis.pack(elvis_accepted_list)]
+ classes = ["completion", "choices"]
+ })
+ elvis_suggestions_list = EList.empty()
+ elvis_suggestions_panel = EPanel.make({EPanel.default_options with
+ children = [Elvis.pack(elvis_suggestions_list)]
+ classes = ["completion", "suggestions"]
+ is_visible = {false}
+ })
+ elvis_panel = EPanel.make({EPanel.default_options with
+ classes = ["completion", "root"]
+ children = [Elvis.pack(elvis_input), Elvis.pack(elvis_suggestions_panel), Elvis.pack(elvis_accepted_panel)]
+ })
+
+ //Show/hide suggestions panel
+ set_suggestions_visible(visible) =
+ (
+ EPanel.set_visible(elvis_suggestions_panel, visible)//Note: In the future, we could replace this by an animation
+ )
+
+ //When value is accepted, show it in [elvis_accepted], store it somewhere, clear [elvis_input], hide [elvis_suggestions_panel]
+ on_value_accepted(value) = (
+ do set_suggestions_visible({false})
+ do EInput.set_text(elvis_input, "", {false})
+ elvis_value_for_display = EClickable.simple(options.display_choice(value))
+ do EList.add_item(elvis_accepted_list, value, Elvis.pack(elvis_value_for_display))
+ //TODO: Store value
+ //value_key = Random.int(10000000) //An arbitrary key, used for storage. Big number to avoid collisions.
+ //TODO: On single click upon [elvis_value], reselect value/text
+ //TODO: On double click upon [elvis_value], remove value
+ //TODO: Trigger event
+ {}
+ )
+
+ //When text changes, show/hide suggestions
+ on_changing_text(text) = (
+ match options.suggest_completions(text) with
+ [] -> //Hide suggestions
+ do set_suggestions_visible({false})
+ void
+ | suggestions -> //Show suggestions
+ do set_suggestions_visible({true})
+ make_suggestion(value) = (
+ clickable = EClickable.simple(options.display_suggestion(value))
+ _ = Event.callback(Elvis.sources(clickable).chosen, (_ -> on_value_accepted(value)))
+ Elvis.pack(clickable)
+ )
+ elvis_suggestions = List.map(x -> (x, make_suggestion(x)), suggestions)
+ do EList.set_items(elvis_suggestions_list, elvis_suggestions)
+ void
+ )
+ _ = Event.callback(Elvis.sources(elvis_input).changing_text, on_changing_text)
+
+ //Finish construction
+ sources = {
+ added_value = (added_value_net)
+ }
+ implem = {}
+ display = elvis_panel.display
+ Elvis.make(sources, implem, display)
+ )
+}}
+
View
118 stdlib/elvis/datepicker.opa
@@ -0,0 +1,118 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Binding of the Datepicker Widget
+ *
+ * @category UI
+ * @author François-Régis Sinot, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Datepicker}
+ *
+ * Demonstrating how to wrap a widget into an elvis.
+ * No support for the "menu-style" datepicker.
+ */
+
+import stdlib.widgets.datepicker
+
+/**
+ * {1 Theming}
+ *
+ * The input always has classes "mlstate", "elvis", "datepicker".
+ */
+
+/**
+ * {1 Sources for this elvis}
+ */
+type EDatepicker.sources =
+{
+ changed_date: Event.source(Date.date)
+}
+
+type EDatepicker.options =
+{
+ initial_date: Date.date
+ /* TODO: all options of WDatepicker.config except stylers */
+}
+
+@abstract type EDatepicker.implementation =
+{
+ /**
+ * Parameters for WDatepicker
+ */
+ wdatepicker_id: string
+ wdatepicker_config: WDatepicker.config
+}
+
+type EDatepicker.elvis = Elvis.elvis(EDatepicker.sources, EDatepicker.implementation)
+
+@client EDatepicker = {{
+ /**
+ * {2 Constructors}
+ */
+ simple(initial_date : Date.date): EDatepicker.elvis =
+ (
+ make({ default_options with ~initial_date})
+ )
+
+ make(options: EDatepicker.options): EDatepicker.elvis =
+ (
+ id_datepicker = "edatepicker_{Random.string(32)}"
+
+ //Setup sources
+ changed_date_net = Network.empty()
+
+ //Translate to WDatepicker
+ wdatepicker_config = WDatepicker.default_config
+
+ display(theme) =
+ (
+ _theme_name = Elvis.Theme.get_classes(theme) /* TODO: use it */
+
+ on_change_date = Network.broadcast(_, changed_date_net)
+
+ xhtml = WDatepicker.edit(wdatepicker_config, on_change_date, id_datepicker, options.initial_date)
+
+ dom = Dom.of_xhtml(xhtml)
+
+ ~{dom xhtml}
+ )
+ sources : EDatepicker.sources =
+ {
+ changed_date = (changed_date_net)
+ }
+ implem : EDatepicker.implementation =
+ ({
+ wdatepicker_id = id_datepicker
+ ~wdatepicker_config
+ })
+ Elvis.make(sources, implem, display)
+ )
+
+ /**
+ * A default set of options
+ */
+ default_options: EDatepicker.options =
+ {initial_date = Date.epoch
+ }
+
+}}
View
150 stdlib/elvis/elvis.opa
@@ -0,0 +1,150 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * An elvis ("element of vision") is a data structure that can be displayed in the browser screen.
+ * Elvises are abstract data structures, characterized by the events they can post (the "sources")
+ * and their accessors.
+ *
+ * ** Relationships between Elvises and Xhtml
+ * - elvises are not xhtml (although they are certainly implemented as such)
+ * - elvises are not referenced by their ID
+ * - for display, elvises are inserted into xhtml
+ * - styling, positioning, etc. are done with CSS and selectors, through the indirection of the [Styler] widget
+ * - DOM events are used to implement Elvis, but they are low-level informations, not meant to be seen outside the Elvis
+ *
+ * ** Events
+ * - each Elvis publishes a number of [source]s, corresponding the events it can send
+ * - a channel or a function can be registered to listen on a [source], and possibly unregistered later
+ * - an Elvis MUST NOT listen to its own [source]s
+ *
+ * ** Implementation guidelines
+ * - Each xhtml node in an Elvis should have a class name
+ */
+
+/**
+ * {1 Standard event names}
+ *
+ * - [{chosen: void}] -- a button was pressed, an item was selected in a list, etc.
+ * - [{value_changed: {old: 'a new:'a}}]
+ * - [{value_rejected:{old: 'a rejected:'b}}]
+ */
+
+
+@abstract type Elvis.elvis('sources, 'implem) = {
+ sources: 'sources /**Sources of events that the elvis can send (e.g. "selected", "value changed", etc.)
+ Use this to register event observers (or, possibly, to trigger artificial events).
+
+ Note: By design, an elvis MUST NOT register with its own sources.*/
+ implem: 'implem /**Anything that may be needed to access the functions of this elvis, e.g. to set content*/
+ display: Elvis.theme ->/**Anything required to (re)display the elvis.*/
+ {
+ xhtml: xhtml /**The xhtml code for the display part of this elvis.*/
+ dom: dom /**A {e concrete} [dom] corresponding to [xhtml] page.*/
+ }
+}
+@abstract type Elvis.masked = {}
+@abstract type Elvis.theme = list(string)
+
+Elvis = {{
+ /**
+ * Convert an elvis into something that can be injected on a page
+ *
+ * Note: Called automatically by magic_to_xhtml
+ */
+ for_display(elvis: Elvis.elvis(_, _)): xhtml =
+ (
+ for_display_in_theme(elvis, (["mlstate_default"]))
+ )
+
+ /**
+ * Convert an elvis into something that can be injected on a page
+ */
+ for_display_in_theme(elvis: Elvis.elvis(_, _), theme: Elvis.theme): xhtml =
+ (
+ (elvis).display(theme).xhtml
+ )
+
+ /**
+ * Access the event sources of the elvis
+ */
+ sources(elvis: Elvis.elvis('sources, 'implem)): 'sources =
+ (
+ (elvis).sources
+ )
+
+ implem(elvis: Elvis.elvis('sources, 'implem)): 'implem =
+ (
+ (elvis).implem
+ )
+
+ /**
+ * Construct an Elvis
+ */
+ make(sources: 'sources, implem: 'implem, display: Elvis.theme -> {xhtml:xhtml; dom:dom}): Elvis.elvis('sources, 'implem) =
+ (
+ ({~sources ~implem ~display})
+ )
+
+ /**
+ * Existential stuff
+ */
+ pack(elvis: Elvis.elvis(_, _)): Elvis.elvis(Elvis.masked, Elvis.masked) =
+ (
+ ({sources=masked implem=masked display=(elvis).display})
+ )
+
+ pack_sources(elvis: Elvis.elvis(_, 'b)): Elvis.elvis(Elvis.masked, 'b) =
+ (
+ ({sources=masked implem=(elvis).implem display=(elvis).display})
+ )
+
+ pack_implem(elvis: Elvis.elvis('a, _)): Elvis.elvis('a, Elvis.masked) =
+ (
+ ({sources=(elvis).sources implem=masked display=(elvis).display})
+ )
+
+ masked: Elvis.masked = ({})
+
+ Theme =
+ {{
+ of_classes(classes: list(string)): Elvis.theme =
+ (
+ (classes)
+ )
+
+ get_classes(theme: Elvis.theme): string =
+ (
+ List.to_string_using("", "", " ", (theme))
+ )
+
+ add_class(class:string, theme: Elvis.theme): Elvis.theme =
+ (
+ ([class | (theme)])
+ )
+ }}
+}}
View
81 stdlib/elvis/event.opa
@@ -0,0 +1,81 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Events
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 General definitions}
+ */
+
+@abstract type Event.source('a) = Network.network('a)
+@abstract type Event.observer = (-> void)
+
+Event =
+{{
+ Source =
+ {{
+ /**
+ * Create a source that won't ever send anything.
+ */
+ empty(): Event.source('a) = (Network.empty())
+ }}
+
+ /**
+ * Register to be informed whenever a source produces a new event
+ */
+ observe(source: Event.source('a), sink: channel('a)): Event.observer =
+ (
+ do Network.add(sink, (source))
+ (-> Network.remove(sink, (source)))
+ )
+ /**
+ * As [observe], but with a function
+ */
+ callback(source: Event.source('a), sink: 'a -> void): Event.observer =
+ (
+ observe(source, Session.make({}, (_, msg -> do sink(msg) {unchanged})))
+ )
+ /**
+ * As [callback], but with the function is automatically unregistered once it has been called
+ */
+ callback_once(source: Event.source('a), sink: 'a -> void): Event.observer =
+ (
+ c = Session.make({}, (_, msg -> do sink(msg) {stop}))
+ observe(source, c)
+ )
+
+ /**
+ * Broadcast an event to all observers
+ */
+ trigger(source: Event.source('a), event:'a): void =
+ (
+ Network.broadcast(event, (source))
+ )
+
+ unobserve(observer: Event.observer): void =
+ (
+ (observer)()
+ )
+}}
View
371 stdlib/elvis/input.opa
@@ -0,0 +1,371 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Inputs
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Polymorphic text input}
+ *
+ * A simple text field, holding a value of polymorphic type.
+ *
+ * Expected syntactic sugar:
+ *
+ * <EInput id=#foo default_value="Please enter some text" />
+ *
+ * Translated into:
+ *
+ * foo = let()
+ * ...
+ * bind(foo, EInput.make({EInput.default_options with default_value = "Please enter some text"}))
+ */
+
+/**
+ * {1 Theming}
+ *
+ * The input always has classes "mlstate", "elvis", "input".
+ * At start, the field also has class "init". This class disappears once the field is modified.
+ * When filled with something incorrect, it has class "incorrect". When filled with something correct, it has class "correct".
+ * If enabled, it has class "enabled", otherwise "disabled"
+ */
+
+/**
+ * {1 Sources for this elvis}
+ */
+type EInput.sources('value) =
+{
+ changed_value: Event.source({old:option('value) new:option('value) text:string})
+
+ /**
+ * An event sent when the text is being modified.
+ * Use this e.g. for auto-completion.
+ */
+ changing_text: Event.source(string)
+ changed_focus: Event.source({received}/{lost})
+}
+
+type EInput.options('value) =
+{
+ welcome_text: string
+ default_value: option('value)
+ value_accept: string -> option('value)
+
+ /**
+ * Determine how the value should be displayed.
+ * Used to initialize the elvis, or when the value is set with [set_value].
+ */
+ value_display: option('value) -> string
+ size_columns: int
+ is_enabled: bool
+ is_password: bool
+
+ unfocus_validates: bool
+ newline_validates: bool
+ tab_validates: bool
+}
+
+@abstract type EInput.implementation('value) =
+{
+ /**
+ * A reference to the dom node containing the real input
+ */
+ dom_input: dom
+
+ /**
+ * A reference to the dom node containing the welcome pseudo-input
+ */
+ dom_welcome: dom
+ state: Client.reference((string, option('value)))
+ options: EInput.options('value)
+}
+
+type EInput.elvis('a) = Elvis.elvis(EInput.sources('a), EInput.implementation('a))
+
+@client EInput = {{
+ /**
+ * {2 Constructors}
+ */
+ simple(): EInput.elvis(string) =
+ (
+ make(default_options)
+ )
+
+ make(options: EInput.options('a)): EInput.elvis('a) =
+ (
+ value_accept = options.value_accept
+ default_text = options.value_display(options.default_value)
+ id_input = "einput_{Random.string(32)}"
+ dom_input = Dom.select_id(id_input)
+ id_welcome = "einput_welcome_{Random.string(32)}"
+ dom_welcome = Dom.select_id(id_welcome)
+
+ //Setup sources
+ changed_value_net = Network.empty()
+ changing_text_net = Network.empty()
+ changed_focus_net = Network.empty()
+
+ //Handle validation (and UI side effects)
+ state = Client_reference.create(("", {none}))
+ validator(text:string): void =
+ (
+ old = Client_reference.get(state)
+ if old.f1 != text then
+ new = value_accept(text)
+ do match new with
+ | {none} -> //Value rejected, set class correspondingly
+ do Dom.remove_class(dom_input, class_init)
+ do Dom.remove_class(dom_input, class_correct)
+ do Dom.add_class(dom_input, class_incorrect)
+ void
+ | {some = _} -> //Value accepted, set class correspondingly
+ do Dom.remove_class(dom_input, class_init)
+ do Dom.remove_class(dom_input, class_incorrect)
+ do Dom.add_class(dom_input, class_correct)
+ void
+ do Client_reference.set(state, (text, new))
+ do Network.broadcast({old=old.f2 ~new ~text}, changed_value_net)
+ void
+ )
+
+ //Propagate information that input is changing
+ text = Client_reference.create(default_text)
+ input_changed(_) =
+ (
+ new_text = Dom.get_value(dom_input)
+ if new_text != Client_reference.get(text) then
+ (
+ do Network.broadcast(new_text, changing_text_net)
+ do Client_reference.set(text, new_text)
+ void
+ )
+ )
+
+
+ display(theme) =
+ (
+ theme_name = Elvis.Theme.get_classes(theme)
+
+ //Handle substitution between a placeholder input containing a welcome text and an input actually used for input
+ focus_real_input(enable) =
+ (
+ if enable then
+ (
+ do Dom.hide(dom_welcome)
+ do Dom.show(dom_input)
+ _ = Dom.give_focus(dom_input)
+ void
+ ) else (
+ if Dom.get_value(dom_input) == "" then//No text entered, restore placeholder
+ do Dom.hide(dom_input)
+ do Dom.show(dom_welcome)
+ void
+ )
+ )
+ xhtml = <input id={id_welcome}
+ class="{theme_name} mlstate elvis input {class_init} {if options.is_enabled then class_enabled else class_disabled}"
+ size={options.size_columns}
+ value={options.welcome_text}
+ onready={_ -> Dom.set_enabled(dom_welcome, options.is_enabled)}
+
+ //Setup substitution
+ onfocus={_ -> focus_real_input({true})}
+
+ type="text"
+ />
+ <input id={id_input}
+ class="{theme_name} mlstate elvis input {class_init} {if options.is_enabled then class_enabled else class_disabled}"
+ size={options.size_columns}
+ value={default_text}
+ onready={_ -> Dom.set_enabled(dom_input, options.is_enabled)}
+
+ //Setup substitution
+ style="display:none"
+ onblur={_ -> do Network.broadcast({lost}, changed_focus_net); focus_real_input({false})}
+ onfocus={_ -> Network.broadcast({received}, changed_focus_net)}
+
+ //Setup validation of input
+ onchange={_ -> if options.unfocus_validates then validator(Dom.get_value(dom_input))}
+ options:onchange="stop_propagation"
+ onnewline={_ -> validator(Dom.get_value(dom_input))}
+ options:onnewline="stop_propagation"
+
+ //Setup input change monitoring
+ oninput={input_changed}
+ options:oninput="stop_propagation"
+ onkeyup={input_changed}
+ options:onkeyup="stop_propagation"
+ onpaste={input_changed}
+ options:onpaste="stop_propagation"
+
+ //Setup password
+ type={if options.is_password then "password" else "text"}
+ />
+ dom = Dom.of_xhtml(xhtml)
+ ~{dom xhtml}
+ )
+ sources : EInput.sources('a) =
+ {
+ changed_value = (changed_value_net)
+ changing_text = (changing_text_net)
+ changed_focus = (changed_focus_net)
+ }
+ implem : EInput.implementation('a) =
+ ({
+ ~dom_input
+ ~dom_welcome
+ ~state
+ ~options
+ })
+ Elvis.make(sources, implem, display)
+ )
+
+ /**
+ * A default set of options
+ */
+ default_options: EInput.options(string) =
+ {default_value = {none}
+ welcome_text = ""
+ value_accept = Option.some
+ value_display(x) = x?""
+ size_columns = 20
+ is_enabled = {true}
+ is_password = {false}
+ unfocus_validates = {true}
+ newline_validates = {true}
+ tab_validates = {true}
+ }
+
+ int_options: EInput.options(int) =
+ {default_value = {none}
+ welcome_text = ""
+ value_accept = Parser.try_parse(Rule.integer, _)
+ value_display(x)= match x with {none} -> "" | ~{some} -> String.of_int(some)
+ size_columns = 20
+ is_enabled = {true}
+ is_password = {false}
+ unfocus_validates = {true}
+ newline_validates = {true}
+ tab_validates = {true}
+ }
+
+ password_options: EInput.options(string) =
+ {default_value = {none}
+ welcome_text = "password"
+ value_accept = Option.some
+ value_display(x) = x?""
+ size_columns = 20
+ is_enabled = {true}
+ is_password = {true}
+ unfocus_validates = {true}
+ newline_validates = {true}
+ tab_validates = {true}
+ }
+
+ /**
+ * {2 Accessors}
+ */
+
+ /**
+ * Reset the contents of this input
+ *
+ * @param trigger If true, inform sources of the change, otherwise remain silent.
+ */
+ reset(einput:EInput.elvis('a), trigger:bool): void =
+ (
+ implem = (Elvis.implem(einput))
+ options = implem.options
+ do set_text(einput, options.value_display(options.default_value), false)
+ do set_value(einput, options.default_value, trigger)
+ void
+ )
+
+ /**
+ * {3 Get/set the polymorphic value behind this input}
+ */
+ get_value(einput:EInput.elvis('a)): option('a) =
+ (
+ Client_reference.get((Elvis.implem(einput)).state).f2
+ )
+ set_value(einput:EInput.elvis('a), value:option('a), trigger:bool): void =
+ (
+ implem = (Elvis.implem(einput))
+ options = implem.options
+ dom = Dom.resolve(implem.dom_input)
+ old_value = Client_reference.get(implem.state)
+ do Client_reference.set(implem.state, (options.value_display(value), value))
+ do Dom.set_value(dom, options.value_display(value))
+ do if trigger then
+ Event.trigger(Elvis.sources(einput).changed_value, {old = old_value.f2 text=options.value_display(value) new = value})
+ void
+ )
+
+ /**
+ * {3 Get/set the text of this input}
+ */
+ get_text(einput: EInput.elvis('a)): string =
+ (
+ Dom.get_value((Elvis.implem(einput)).dom_input)
+ )
+ /**
+ * @param as_user If true, simulate a user entering new content, updating sources, etc. Otherwise, just update the text.
+ */
+ set_text(einput:EInput.elvis('a), text:string, as_user:bool): void =
+ (
+ implem = (Elvis.implem(einput))
+ do Dom.set_value(implem.dom_input, text)
+ do if as_user then Dom.trigger(implem.dom_input, {change})
+ void
+ )
+
+
+ /**
+ * {3 Get/set editability of this input}
+ */
+ is_editable(einput:EInput.elvis('a)): bool =
+ (
+ implem = (Elvis.implem(einput))
+ Dom.is_enabled(implem.dom_input)
+ )
+ set_editable(einput:EInput.elvis('a), editable:bool): void =
+ (
+ implem = (Elvis.implem(einput))
+ dom = Dom.resolve(Dom.unsplit([implem.dom_input, implem.dom_welcome]))
+ do Dom.set_enabled(dom, editable)
+ do if editable then
+ do Dom.remove_class(dom, class_disabled)
+ do Dom.add_class(dom, class_enabled)
+ void
+ else
+ do Dom.remove_class(dom, class_enabled)
+ do Dom.add_class(dom, class_disabled)
+ void
+ void
+ )
+
+ @private class_init = "init"
+ @private class_correct = "correct"
+ @private class_incorrect = "incorrect"
+ @private class_enabled = "enabled"
+ @private class_disabled = "disabled"
+}}
View
50 stdlib/elvis/label.opa
@@ -0,0 +1,50 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Labels
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Simple display}
+ *
+ * Display some xhtml content as an elvis.
+ */
+
+type ELabel.sources = {}
+@abstract type ELabel.implementation = {}
+type ELabel.elvis = Elvis.elvis(ELabel.sources, ELabel.implementation)
+
+ELabel =
+{{
+ simple(content:xhtml): ELabel.elvis =
+ make(_ -> content)
+
+ make(content: Elvis.theme -> xhtml): ELabel.elvis =
+ display(theme) =
+ xhtml = content(theme)
+ dom = Dom.of_xhtml(xhtml)
+ {~xhtml ~dom}
+ Elvis.make(void, (void), display)
+
+}}
View
172 stdlib/elvis/list.opa
@@ -0,0 +1,172 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Lists
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Lists}
+ *
+ * Lists, menus, tabs...
+ */
+
+/**
+ * {1 Theming}
+ *
+ * The list always has classes "mlstate", "elvis", "list".
+ */
+
+type EList.options('key) =
+{
+ items: list(('key, Elvis.elvis(Elvis.masked, Elvis.masked)))
+}
+
+type EList.sources =
+{
+}
+
+@abstract type EList.implementation('key) = {
+ dom: dom
+ id: string
+ current_display: Client.reference(Elvis.theme -> {xhtml: xhtml dom:dom})
+ current_theme: Client.reference(option(Elvis.theme))
+ current_items: Client.reference(list(('key, Elvis.elvis(Elvis.masked, Elvis.masked))))
+}
+
+type EList.elvis('key) = Elvis.elvis(EList.sources, EList.implementation('key))
+
+EList =
+{{
+/**
+ * {1 Constructors}
+ */
+ empty(): EList.elvis('a) =
+ make({items = []})
+
+ simple(items: list(Elvis.elvis(Elvis.masked, Elvis.masked))): EList.elvis(int) =
+ make({items = List.map((item -> (Random.int(1000000), item)), items)})
+
+ make(options: EList.options('a)): EList.elvis('a) =
+ (
+ id = "elist_{Random.string(32)}"
+ dom = Dom.select_id(id)
+ display = make_display(options.items, id)
+ current_display = Client_reference.create(display)
+ current_theme = Client_reference.create({none})
+ current_items = Client_reference.create(options.items)
+ display(theme) =
+ (
+ do Client_reference.set(current_theme, {some = theme})
+ Client_reference.get(current_display)(theme)
+ )
+ implementation = (~{dom id current_display current_theme current_items})
+ Elvis.make({}, implementation, display)
+ )
+
+ default_options =
+ {
+ items = []
+ }
+
+/**
+ * {1 Accessors}
+ */
+
+ /**
+ * Change the items in this list. Redisplay the elvis if necessary.
+ */
+ set_items(list: EList.elvis('a), items: list(('a, Elvis.elvis(Elvis.masked, Elvis.masked)))): void =
+ (
+ implem = (Elvis.implem(list))
+
+ //1. Rebuild function [display], so that further displays of this elvis are possible
+ current_display = implem.current_display
+ id = implem.id
+ display = make_display(items, id)
+ do Client_reference.set(current_display, display)
+
+ //2. Update browser UI if the elvis is currently displayed
+ current_theme = implem.current_theme
+ do match Client_reference.get(current_theme) with
+ | {none} -> void //The elvis is not displayed for the moment
+ | ~{some}->
+ target = Dom.resolve(implem.dom)
+ content = display(some).dom
+ _ = Dom.put_replace(target, content)
+ void
+
+ //3. Update reference
+ do Client_reference.set(implem.current_items, items)
+
+ void
+ )
+
+ set_items_nokey(list: EList.elvis('a), items: list(Elvis.elvis(Elvis.masked, Elvis.masked))): void =
+ (
+ set_items(list, List.map(item -> (Random.int(1000000), item), items))
+ )
+
+ /**
+ * Add an item to the list, as first element
+ *
+ * Note: Behavior is undefined if the item is already displayed somewhere
+ */
+ add_item(list: EList.elvis('a), key: 'a, item: Elvis.elvis(Elvis.masked, Elvis.masked)): void =
+ (
+ implem = (Elvis.implem(list))
+
+ do set_items(list, [(key, item) | Client_reference.get(implem.current_items)])
+ void
+ )
+
+ /**
+ * Remove an item from the list
+ */
+ remove_item(list: EList.elvis('a), key:'a): void =
+ (
+ implem = (Elvis.implem(list))
+
+ do set_items(list, List.remove_p(((current_key, _) -> current_key == key), Client_reference.get(implem.current_items)))
+ void
+ )
+
+ @private make_display(items:list(('a, Elvis.elvis(Elvis.masked, Elvis.masked))), id:string) =
+ (
+ display(theme) =
+ (
+ theme_classes= Elvis.Theme.get_classes(theme)
+ xhtml =
+ <ul id={id} class="{theme_classes} mlstate elvis list">
+ {
+ List.map((child -> <li class="list_child">{Elvis.for_display_in_theme(child.f2, theme)}</li>), items)
+ }
+ </ul>
+ dom = Dom.of_xhtml(xhtml)
+ ~{xhtml dom}
+ )
+ display
+ )
+
+}}
+
View
118 stdlib/elvis/panel.opa
@@ -0,0 +1,118 @@
+/*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+/**
+ * Elvis Panels
+ *
+ * @category UI
+ * @author David Rajchenbach-Teller, 2011
+ * @destination PUBLIC
+ * @stability EXPERIMENTAL
+ */
+
+/**
+ * {1 Panels}
+ *
+ * Panels have multiple uses:
+ * - they serve as containers for several elvises
+ * - they serve as cut-off points for changing theme, e.g. the theme outside a panel can be different from the theme inside the panel
+ * - they can be given classes that can be referenced from CSS, e.g. to allow sizing
+ * - children elvises are automatically given classes, e.g. to allow positioning
+ */
+
+/**
+ * {1 Theming}
+ *
+ * The panel always has classes "mlstate", "elvis", "panel", plus any classes implied by the theme or by the options.
+ * The children of the panel have the same theme as the panel itself, which is either the theme provided as option, or otherwise the parent theme.
+ * Each child is embedded in a container numbered [panel_child_0], [panel_child_1], etc.
+ */
+
+type EPanel.options =
+{
+ classes: list(string)
+ children: list(Elvis.elvis(Elvis.masked, Elvis.masked))
+ theme: option(Elvis.theme)
+ is_visible: bool
+}
+
+type EPanel.sources =
+{
+}
+
+@abstract type EPanel.implementation = {
+ dom: dom
+}
+
+type EPanel.elvis = Elvis.elvis(EPanel.sources, EPanel.implementation)
+
+EPanel =
+{{
+/**
+ * {1 Constructors}
+ */
+ make(options: EPanel.options): EPanel.elvis =
+ (
+ id = "epanel_{Random.string(32)}"
+ dom = Dom.select_id(id)
+ content(parent_theme) =
+ theme = options.theme?parent_theme
+ theme_classes= Elvis.Theme.get_classes(theme)
+ more_classes = List.to_string_using("", "", " ", options.classes)
+ xhtml =
+ <div id={id} class="{theme_classes} mlstate elvis panel {more_classes}" style={if not(options.is_visible) then [{display = {css_none}}] else []}>
+ {
+ List.map((child -> <div class="panel_child">{Elvis.for_display_in_theme(child, theme)}</div>), options.children)
+ }
+ </div>
+ dom = Dom.of_xhtml(xhtml)
+ {~dom ~xhtml}
+ Elvis.make({}, ({~dom}), content)
+ )
+
+ default_options =
+ {
+ classes = []
+ children= []
+ theme = {none}
+ is_visible = {true}
+ }
+
+/**
+ * {1 Effects}
+ */
+ set_visible(panel: EPanel.elvis, visible: bool): void =
+ (
+ dom = (Elvis.implem(panel)).dom
+ if visible then Dom.show(dom) else Dom.hide(dom)
+ )
+
+ transition(panel: EPanel.elvis, transition: Dom.animation): void =
+ (
+ dom = (Elvis.implem(panel)).dom
+ _ = Dom.transition(dom, transition)
+ void
+ )
+
+ scroll_into_view(panel: EPanel.elvis): void =
+ (
+ dom = (Elvis.implem(panel)).dom
+ do Dom.scroll_into_view(dom)
+ void
+ )
+}}

0 comments on commit c252d10

Please sign in to comment.