The current counter is: fill-me-in
+ + +}| +} +We can even look at this in a standard web browser. + +Once we're happy with the statics of our program, we can inject dynamic behavior. +Write a file called @filepath{tick-tock.rkt} with the following content. +@filebox["tick-tock.rkt"]{ +@codeblock|{ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/web-world) + (planet dyoo/whalesong/resource)) + +(define-resource index.html) + +;; draw: world view -> view +(define (draw world dom) + (update-view-text (view-focus dom "#counter") world)) + + +;; tick: world view -> world +(define (tick world dom) + (add1 world)) + + +;; stop?: world view -> boolean +(define (stop? world dom) + (> world 10)) + +(big-bang 0 + (initial-view index.html) + (to-draw draw) + (on-tick tick 1) + (stop-when stop?)) +}| +} + +Several things are happening here. +@itemize[ + +@item{We @racket[require] a few libraries to get us some additional +behavior; in particular, @racketmodname/this-package[web-world] to let +us write event-driven web-based programs, and @racketmodname/this-package[resource] +to give us access to external @tech{resource}s.} + +@item{We use @racket[define-resource] to refer to external files, like @filepath{index.html} that +we'd like to include in our program.} + +@item{We use @racket[big-bang] to start up a computation that +responses to events. In this example, that's clock ticks introduced +by @racket[on-tick], though because we're on the web, we can +bind to many other kinds of web events (by using @racket[view-bind]).} +] + +The rest of this document describes the API. + + + + + + +@section{API} + +@defmodule/this-package[web-world] + +For the purposes of tour-guide, we'll be focusing on the +@racketmodname/this-package[web-world] library in Whalesong. + +Like the big-bang in regular world, the callbacks are world-to-world +functions. One difference introduced by the web is the web page +itself: because the page itself is a source of state, it too will be +passed to callbacks. This library presents a +functional version of the DOM in the form of a @tech{view}. + +The world-updating callbacks may optionally take an @tech{event} object, which +provides additional information about the event that triggered the callback. + + + +@defproc[(big-bang [w world] + [h big-bang-handler] ...) world]{ +Start a big bang computation. +} +@defproc[(initial-view [x any]) big-bang-handler]{ +Provide an initial view for the big-bang. Normally, @racket[x] will be a @tech{resource} +to a web page. +@codeblock|{ +... +(define-resource page1.html) +... +(big-bang ... + (initial-view page1.html)) +}| +} + + +@defproc[(stop-when [stop? ([w world] [dom view] -> boolean)]) big-bang-handler]{ +Tells @racket[big-bang] when to stop. +@codeblock|{ +... +(define-struct world (given expected)) +... + +;; stop?: world view -> boolean +(define (stop? world dom) + (string=? (world-given world) (world-expected world))) + +(big-bang ... + (stop-when stop?)) +}| +} + + +@defproc*[(((on-tick [tick-f ([w world] [v view] [e event]? -> world)] [delay real]) big-bang-handler) + ((on-tick [tick-f ([w world] [v view] [e event]? -> world)]) big-bang-handler))]{ +Tells @racket[big-bang] to update the world during clock ticks. + +By default, this will send a clock tick 28 times a second, but if +given @racket[delay], it will use that instead. +@codeblock|{ +... +;; tick: world dom -> world +(define (tick world view) + (add1 world)) + +(big-bang ... + (on-tick tick 5)) ;; tick every five seconds +}| +} + + +@defproc[(on-mock-location-change [location-f ([w world] [v view] [e event]? -> world)]) big-bang-handler]{ +Tells @racket[big-bang] to update the world during simulated movement. + +During the extent of a big-bang, a form widget will appear in the +@tt{document.body} to allow us to manually send location-changing +events. + +The optional @tech{event} argument will contain numbers for +@racket["latitude"] and @racket["longitude"]. +@codeblock|{ +... +;; move: world view event -> world +(define (move world dom event) + (list (event-ref event "latitude") + (event-ref event "longitude"))) +... +(big-bang ... + (on-mock-location-change move)) +}| +} + + +@defproc[(on-location-change [location-f ([w world] [v view] [e event]? -> world)]) big-bang-handler]{ +Tells @racket[big-bang] to update when the location changes, as +received by the +@link["http://dev.w3.org/geo/api/spec-source.html"]{Geolocation API}. + +The optional @tech{event} argument will contain numbers for +@racket["latitude"] and @racket["longitude"]. +@codeblock|{ +... +;; move: world view event -> world +(define (move world dom event) + (list (event-ref event "latitude") + (event-ref event "longitude"))) +... +(big-bang ... + (on-location-change move)) +}| +} + + + + +@defproc[(to-draw [draw-f ([w world] [v view] -> view)]) big-bang-handler]{ +Tells @racket[big-bang] how to update the rendering of the world. The draw +function will be called every time an event occurs. + +@codeblock|{ +... +(define-struct world (name age)) + +;; draw: world view -> view +(define (draw world dom) + (update-view-text (view-focus dom "#name-span") + (world-name world))) +... +(big-bang ... + (to-draw draw)) +}| +} + + + +@subsection{Views} + +A @deftech{view} is a functional representation of the browser DOM +tree. A view is always focused on an element, and the functions in +this subsection show how to traverse and manipulate the view. + + + +@defproc[(->view [x any]) view]{ + +Coerse a value into a view whose focus is on the topmost element. +Common values for @racket[x] include @tech{resource}s. +} + + +@defproc[(view-focus [v view] [selector String]) view]{ +Focuses the view on an element, given the @racket[selector]. The view +will be searched starting from the toplevelmost node. + +Selectors are currently restricted to @litchar{#id} selectors for the +moment. +} + + +@defproc[(view-left [v view]) view]{ +Move the focus to the previous sibling. +} +@defproc[(view-right [v view]) view]{ +Move the focus to the next sibling.} + +@defproc[(view-up [v view]) view]{ +Move the focus to the parent.} + +@defproc[(view-down [v view]) view]{ +Move the view to the first child.} + +@defproc[(view-text [v view]) string]{ +Get the textual content at the focus. +} +@defproc[(update-view-text [v view] [s string]) view]{ +Update the textual content at the focus.} + +@defproc[(view-bind [v view] [type string] [world-updater ([w world] [v view] [e event]? -> world)]) view]{ +Attach a world-updating event to the focus. + +Attach a world-updating event to the focus. When the world-updater is +called, the view will be focused on the element that triggered the +event. + +Common event types include @racket["click"], @racket["mouseenter"], @racket["change"].} + +@defproc[(view-show [v view]) view]{ +Show the element at the focus. +} +@defproc[(view-hide [v view]) view]{ +Hide the element at the focus. +} + +@defproc[(view-attr [v view] [name String]) view]{ +Get the attribute @racket[name] at the focus. +} + +@defproc[(update-view-attr [v view] [name String] [value String]) view]{ +Update the attribute @racket[n] with the value @racket[v] at the focus. +} + +@defproc[(view-id [v view]) world]{ +Get the unique identifier of the node at the focus. +} + +@defproc[(view-form-value [v view]) view]{ +Get the form value of the node at the focus.} + +@defproc[(update-view-form-value [v view] [value String]) view]{ +Update the form value of the node at the focus.} + +@defproc[(view-append-child [d dom]) view]{ +Add the dom node @racket[d] as the last child of the focused node.} + + + +@subsection{Events} + +An @deftech{event} is a structure that holds name-value pairs. +Whenever an event occurs in web-world, it may include some auxiliary +information about the event. As a concrete example, location events +from @racket[on-location-change] and @racket[on-mock-location-change] +can send latitude and longitude values, as long as the world callback +can accept the event as an argument. + + +@defstruct[event ([kvpairs (listof (list symbol (or/c string number)))])]{} + +@defproc[(event-ref [evt event?] [name (or/c symbol string)]) value]{ +Get an value from the event, given its @racket[name]. +} + +@defproc[(event-keys [evt event?]) (listof symbol)]{ +Get an list of the event's keys. +} + + + + +@section{Including external resources} +@defmodule/this-package[resource] + +Programs may need to use an external file @deftech{resource} that isn't +itself a Racket program, but instead some other kind of data. +Graphical programs will often use @filepath{.png}s, and web-related +programs @filepath{.html}s, for example. Whalesong provides the +@racketmodname/this-package[resource] library to refer and use these +external resources. When Whalesong compiles a program into a package, +these resources will be bundled alongside the JavaScript-compiled +output. + +@defform[(define-resource id [path-string])]{ +Defines a resource with the given path name. + +For example, +@codeblock|{ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/resource)) +(define-resource my-whale-image-resource "humpback.png") +}| +} +As a convenience, we can also write +@codeblock|{ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/resource)) +(define-resource humpback.png) +}| +which defines a variable named @racket[humpback.png] whose +resource is @filepath{humpback.png}. + + + +@defproc[(resource->url [a-resource resource?]) string?]{ +Given a resource, gets a URL. + +For example, +@codeblock|{ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/resource) + (planet dyoo/whalesong/image)) + +(define-resource my-whale-image-resource "humpback.png") + +(define WHALE-IMAGE + (bitmap/url (resource->url my-whale-image-resource))) +}| + +} + + + + +@section{Tips and Tricks} +@subsection{Hiding standard output or directing it to an element} + +@declare-exporting/this-package[web-world] + +For a web-world program, output is normally done by using +@racket[to-draw]. However, side effecting functions, such as +@racket[printf] or @racket[display], are still available, and are +allowed to continue to append to @tt{document.body}. + +We may want to disable such printing or redirect it to a particular +element on the page. For such purposes, use a combination of +@racket[current-output-port] and @racket[open-output-element] to +redirect the output of these side effect functions to somewhere else. + +For example: +@codeblock|{ +... +;; Redirect standard output to a div called "stdout-div". +(current-output-port (open-output-element "stdout-div")) +... +(big-bang ... + (on-tick (lambda (world dom) + (printf "Tick!\n") + (add1 world))) + ...) +}| + + +All subsequent I/O side effects after the call to +@racket[current-output-port] will be written out to the +@tt{stdout-div}, which can be easily styled with @tt{display: none} to +hide it from normal browser display. + + + +@defproc[(open-output-element [id string]) output-port]{ +Opens an output port that will be directed to write to the DOM element +whose id is @racket[id]. Note: writing to this port shouldn't fail, +even if the id does not currently exist on the page. +} \ No newline at end of file diff --git a/version.rkt b/version.rkt index cdb657d..19fdaa0 100644 --- a/version.rkt +++ b/version.rkt @@ -1,4 +1,4 @@ #lang typed/racket/base (provide version) (: version String) -(define version "1.0") \ No newline at end of file +(define version "1.0") diff --git a/web-world/event.rkt b/web-world/event.rkt new file mode 100644 index 0000000..cd6956a --- /dev/null +++ b/web-world/event.rkt @@ -0,0 +1,25 @@ +#lang s-exp "../lang/base.rkt" + +(provide (all-defined-out)) + +(define-struct event (kvpairs)) + + +(define (event-keys an-evt) + (map car (event-kvpairs an-evt))) + + +(define (event-ref an-evt a-key) + (define clean-key (cond + [(symbol? a-key) + a-key] + [(string? a-key) + (string->symbol a-key)] + [else + (raise-type-error 'event-ref "symbol or string" a-key)])) + (define kv (assq clean-key (event-kvpairs an-evt))) + (cond [(eq? kv #f) + (error 'event-ref "Could not find key ~a" a-key)] + [else + (car (cdr kv))])) + diff --git a/web-world/examples/dwarves/dwarves.rkt b/web-world/examples/dwarves/dwarves.rkt new file mode 100644 index 0000000..29675c9 --- /dev/null +++ b/web-world/examples/dwarves/dwarves.rkt @@ -0,0 +1,53 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/web-world) + (planet dyoo/whalesong/resource)) +(define-resource index.html) + +;; The world is the set of dwarfs. + + +;; make-item: string -> view +(define (make-item name) + (view-bind (->view `(li ,name)) + "click" + hide-on-click)) + + +;; When a dwarf clicks, it hides! +(define (hide-on-click w v) + (remove (view-id v) w)) + + +(define dwarf-names + '("Doc" "Grumpy" "Happy" "Sleepy" "Bashful" "Sneezy" "Dopey")) + + +;; Update the view so it shows the next dwarf on the scene, +;; until we're all done. +(define (draw w dom-view) + (foldl (lambda (name view) + (define focused (view-focus view (format "#~a" name))) + (cond + [(member name w) + (view-show focused)] + [else + (view-hide focused)])) + dom-view + dwarf-names)) + + + +;; The first view consists of index.html. We attach event handlers +;; to each name here. +(define my-view + (foldl (lambda (name view) + (view-bind (view-focus view (format "#~a" name)) + "click" + hide-on-click)) + (->view index.html) + dwarf-names)) + + +(big-bang dwarf-names + (initial-view my-view) + (to-draw draw)) diff --git a/web-world/examples/dwarves/index.html b/web-world/examples/dwarves/index.html new file mode 100644 index 0000000..71e62c4 --- /dev/null +++ b/web-world/examples/dwarves/index.html @@ -0,0 +1,16 @@ + +Click on a dwarf to make them hide.
+The current counter is: fill-me-in
+ + +There is content from the printf statements going into + the hidden div below:
+ + + + diff --git a/web-world/examples/redirected/redirected.rkt b/web-world/examples/redirected/redirected.rkt new file mode 100644 index 0000000..51101f3 --- /dev/null +++ b/web-world/examples/redirected/redirected.rkt @@ -0,0 +1,26 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/web-world) + (planet dyoo/whalesong/resource)) + +(define-resource index.html) + +(current-output-port (open-output-element "stdout")) + + +;; draw: world view -> view +(define (draw w v) + (update-view-text (view-focus v "#counter") w)) + + + +;; tick: world view -> world +(define (tick w v) + (printf "Tick ~s\n" w) + (+ w 1)) + +(big-bang 0 + (initial-view index.html) + (to-draw draw) + (on-tick tick 1) + (stop-when (lambda (w v) + (> w 10)))) diff --git a/web-world/examples/where-am-i/index.html b/web-world/examples/where-am-i/index.html new file mode 100644 index 0000000..d1ace0c --- /dev/null +++ b/web-world/examples/where-am-i/index.html @@ -0,0 +1,9 @@ + ++ I am at: dunno. + The mock location says: dunno. +
+ + diff --git a/web-world/examples/where-am-i/where-am-i.rkt b/web-world/examples/where-am-i/where-am-i.rkt new file mode 100644 index 0000000..f0db836 --- /dev/null +++ b/web-world/examples/where-am-i/where-am-i.rkt @@ -0,0 +1,45 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/web-world) + (planet dyoo/whalesong/resource)) + +(define-resource index.html) + +(define-struct coord (lat lng)) +(define-struct world (real mock)) + + + +(define (location-change world dom evt) + (make-world (make-coord (event-ref evt "latitude") + (event-ref evt "longitude")) + (world-mock world))) + + +(define (mock-location-change world dom evt) + (make-world (world-real world) + (make-coord (event-ref evt "latitude") + (event-ref evt "longitude")))) + + +(define (draw world dom) + (define v1 (if (coord? (world-real world)) + (update-view-text (view-focus dom "#real-location") + (format "lat=~a, lng=~a" + (coord-lat (world-real world)) + (coord-lng (world-real world)))) + dom)) + (define v2 (if (coord? (world-mock world)) + (update-view-text (view-focus v1 "#mock-location") + (format "lat=~a, lng=~a" + (coord-lat (world-mock world)) + (coord-lng (world-mock world)))) + v1)) + v2) + + + +(big-bang (make-world 'unknown 'unknown) + (initial-view index.html) + (to-draw draw) + (on-location-change location-change) + (on-mock-location-change mock-location-change)) \ No newline at end of file diff --git a/web-world/impl.rkt b/web-world/impl.rkt index 974b2b0..5143935 100644 --- a/web-world/impl.rkt +++ b/web-world/impl.rkt @@ -1,9 +1,8 @@ #lang s-exp "../lang/js/js.rkt" -;; Make sure the resource library is loaded. -(require "../resource.rkt") - +;; Make sure the resource library is loaded, as well as the event structure library. +(require "../resource.rkt" "event.rkt") (declare-implementation #:racket "racket-impl.rkt" @@ -20,8 +19,17 @@ ;; clock tick handler on-tick + ;; location changes + on-mock-location-change + + ;; location changes (for real!) + on-location-change + ;; draw and update the view to-draw + + ;; helper: open an element as an output port. + open-output-element ;; coerse to view ->view @@ -36,10 +44,16 @@ update-view-text view-bind + + view-show + view-hide view-attr update-view-attr + view-id + view-form-value update-view-form-value + view-append-child )) diff --git a/web-world/info.rkt b/web-world/info.rkt new file mode 100644 index 0000000..7e41f36 --- /dev/null +++ b/web-world/info.rkt @@ -0,0 +1,3 @@ +#lang setup/infotab + +(define compile-omit-paths '("examples")) diff --git a/web-world/js-impl.js b/web-world/js-impl.js index 6982ca4..ce45bcf 100644 --- a/web-world/js-impl.js +++ b/web-world/js-impl.js @@ -9,6 +9,9 @@ var finalizeClosureCall = plt.baselib.functions.finalizeClosureCall; var PAUSE = plt.runtime.PAUSE; var isString = plt.baselib.strings.isString; + var makeList = plt.baselib.lists.makeList; + var makePair = plt.baselib.lists.makePair; + var makeSymbol = plt.baselib.symbols.makeSymbol; @@ -22,6 +25,10 @@ var resourceStructType = MACHINE.modules['whalesong/resource/structs.rkt'].namespace['struct:resource']; + var eventStructType = + MACHINE.modules['whalesong/web-world/event.rkt'].namespace['struct:event']; + + var domToCursor = function(dom) { var domOpenF = @@ -261,17 +268,14 @@ // HACK: every node that is bound needs to have an id. We // enforce this by mutating the node. - if ($(this.cursor.node).attr("id") === undefined) { - $(this.cursor.node).attr("id", - ("__webWorldId_" + mockViewIdGensym++)); - } - + if (! this.cursor.node.id) { + this.cursor.node.id = ("__webWorldId_" + mockViewIdGensym++); + } return this.act( function(cursor) { var newCursor = cursor.replaceNode($(cursor.node).clone(true).get(0)); var handler = new EventHandler(name, - new DomEventSource(name, - newCursor.node), + new DomEventSource(name, newCursor.node), worldF); if (currentBigBangRecord !== undefined) { currentBigBangRecord.startEventHandler(handler); @@ -282,21 +286,80 @@ var handler = new EventHandler(name, new DomEventSource( name, - $(that.cursor.node).attr('id')), + that.cursor.node.id), worldF); return eventHandlers.concat([handler]); }, function(view) { + // HACK: every node that is bound needs to have an id. We + // enforce this by mutating the node. + if (! view.focus.get(0).id) { + view.focus.get(0).id = ("__webWorldId_" + mockViewIdGensym++); + } var handler = new EventHandler(name, new DomEventSource( name, - view.focus.get(0)), + view.focus.get(0).id), worldF); view.addEventHandler(handler); currentBigBangRecord.startEventHandler(handler); }); }; + MockView.prototype.show = function() { + return this.act( + function(cursor) { + return cursor.replaceNode($(cursor.node).clone(true).show().get(0)); + }, + function(eventHandlers) { return eventHandlers; }, + function(view) { + view.focus.show(); + } + ) + }; + + MockView.prototype.hide = function() { + return this.act( + function(cursor) { + return cursor.replaceNode($(cursor.node).clone(true).hide().get(0)); + }, + function(eventHandlers) { return eventHandlers; }, + function(view) { + view.focus.hide(); + } + ) + }; + + + MockView.prototype.appendChild = function(domNode) { + return this.act( + function(cursor) { + if (cursor.canDown()) { + cursor = cursor.down(); + while (cursor.canRight()) { + cursor = cursor.right(); + } + return cursor.insertRight(domNode.cloneNode(true)); + } else { + return cursor.insertDown(domNode.cloneNode(true)); + } + }, + function(eventHandlers) { return eventHandlers; }, + function(view) { + var clone = $(domNode).clone(true); + clone.appendTo(view.focus); + view.focus = clone; + } + ) + }; + + MockView.prototype.id = function() { + return this.cursor.node.id; + }; + + + + ////////////////////////////////////////////////////////////////////// @@ -422,6 +485,40 @@ }; + var coerseToDomNode = function(x, onSuccess, onFail) { + var dom; + if (isDomNode(x)) { + return onSuccess(x); + } else if (isResource(x)) { + try { + dom = $(resourceContent(x).toString()) + .css("margin", "0px") + .css("padding", "0px") + .css("border", "0px"); + } catch (exn) { + return onFail(exn); + } + return onSuccess(dom.get(0)); + } else if (isMockView(x)) { + return onSuccess(x.cursor.top().node); + } else { + try { + dom = plt.baselib.format.toDomNode(x); + } catch (exn) { + return onFail(exn); + } + return onSuccess(dom); + } + }; + + + var isDomNode = function(x) { + return (x.hasOwnProperty('nodeType') && + x.nodeType === 1); + }; + + + @@ -484,6 +581,15 @@ EventHandler.prototype.toString = function() { return "#<" + this.name + ">"; }; var isEventHandler = plt.baselib.makeClassPredicate(EventHandler); + + + var WithOutputToHandler = function(outputPort) { + this.outputPort = outputPort; + }; + WithOutputToHandler.prototype = plt.baselib.heir(WorldHandler.prototype); + var isWithOutputToHandler = plt.baselib.makeClassPredicate(WithOutputToHandler); + + ////////////////////////////////////////////////////////////////////// @@ -510,6 +616,29 @@ + // convert an object to an event. + // At the moment, we only copy over those values which are numbers or strings. + var objectToEvent = function(obj) { + var key, val; + var result = makeList(); + for (key in obj) { + if (obj.hasOwnProperty(key)) { + val = obj[key]; + if (typeof(val) === 'number') { + result = makePair(makeList(makeSymbol(key), + plt.baselib.numbers.makeFloat(val)), + result); + } else if (typeof(val) === 'string') { + result = makePair(makeList(makeSymbol(key), val), + result); + } + } + } + return eventStructType.constructor(result); + }; + + + /* Event sources. @@ -556,8 +685,9 @@ TickEventSource.prototype.onStart = function(fireEvent) { this.id = setInterval( - function() { - fireEvent(undefined); + function(evt) { + fireEvent(undefined, + objectToEvent(evt)); }, this.delay); }; @@ -570,6 +700,93 @@ }; + + + + + var MockLocationEventSource = function() { + this.elt = undefined; + }; + MockLocationEventSource.prototype = plt.baselib.heir(EventSource.prototype); + MockLocationEventSource.prototype.onStart = function(fireEvent) { + var mockLocationSetter = document.createElement("div"); + + var latInput = document.createElement("input"); + latInput.type = "text"; + + var latOutput = document.createElement("input"); + latOutput.type = "text"; + + var submitButton = document.createElement("input"); + submitButton.type = "button"; + submitButton.value = "send lat/lng"; + submitButton.onclick = function() { + fireEvent(undefined, + objectToEvent({ latitude: Number(latInput.value), + longitude: Number(latOutput.value)})); + return false; + }; + + mockLocationSetter.style.border = "1pt solid black"; + mockLocationSetter.appendChild( + document.createTextNode("mock location setter")); + mockLocationSetter.appendChild(latInput); + mockLocationSetter.appendChild(latOutput); + mockLocationSetter.appendChild(submitButton); + document.body.appendChild(mockLocationSetter); + + this.elt = mockLocationSetter; + }; + + MockLocationEventSource.prototype.onStop = function() { + if (this.elt !== undefined) { + document.body.removeChild(this.elt); + this.elt = undefined; + }; + }; + + + + + + // This version really does use the geolocation object. + var LocationEventSource = function() { + this.id = undefined; + }; + + LocationEventSource.prototype = plt.baselib.heir(EventSource.prototype); + + LocationEventSource.prototype.onStart = function(fireEvent) { + var success = function(position) { + fireEvent(undefined, + objectToEvent(position.coords)); + }; + var fail = function(err) { + // Quiet failure + } + if (!!(navigator.geolocation)) { + navigator.geolocation.getCurrentPosition(success, fail); + this.id = navigator.geolocation.watchPosition(success, fail); + } + }; + + LocationEventSource.prototype.onStop = function() { + if (this.id !== undefined) { + navigator.geolocation.clearWatch(this.id); + this.id = undefined; + }; + }; + + + + + + + + + + + // DomElementSource: string (U DOM string) -> EventSource // A DomEventSource allows DOM elements to send events over to // web-world. @@ -589,7 +806,7 @@ this.handler = function(evt) { if (element !== undefined) { - fireEvent(element, evt); + fireEvent(element, objectToEvent(evt)); } }; if (element !== undefined) { @@ -663,12 +880,19 @@ var stopWhen = (find(handlers, isStopWhenHandler) || { stopWhen: defaultStopWhen }).stopWhen; var toDraw = (find(handlers, isToDrawHandler) || {toDraw : defaultToDraw} ).toDraw; + var oldOutputPort = MACHINE.params.currentOutputPort; + var eventQueue = new EventQueue(); var top = $(""); var eventHandlers = filter(handlers, isEventHandler).concat(view.getEventHandlers()); MACHINE.params.currentDisplayer(MACHINE, top); + + // From this point forward, redirect standard output if requested. + if (find(handlers, isWithOutputToHandler)) { + MACHINE.params.currentOutputPort = find(handlers, isWithOutputToHandler).outputPort; + } PAUSE(function(restart) { var i; @@ -678,6 +902,7 @@ stopEventHandlers(); restart(function(MACHINE) { MACHINE.argcount = oldArgcount; + MACHINE.params.currentOutputPort = oldOutputPort; currentBigBangRecord = oldCurrentBigBangRecord; finalizeClosureCall(MACHINE, world); }); @@ -688,6 +913,7 @@ stopEventHandlers(); restart(function(MACHINE) { currentBigBangRecord = oldCurrentBigBangRecord; + MACHINE.params.currentOutputPort = oldOutputPort; plt.baselib.exceptions.raise(MACHINE, exn); }); }; @@ -752,29 +978,37 @@ // FIXME: deal with event data here racketWorldCallback = nextEvent.handler.racketWorldCallback; - racketWorldCallback(MACHINE, - world, - mockView, - // data, - function(newWorld) { - world = newWorld; - stopWhen(MACHINE, - world, - mockView, - function(shouldStop) { - if (shouldStop) { - refreshView( - function() { - onCleanRestart(); - }, - fail); - } else { - dispatchEventsInQueue(success, fail); - } - }, - fail); - }, - fail); + data = nextEvent.data[0]; + var onGoodWorldUpdate = + function(newWorld) { + world = newWorld; + stopWhen(MACHINE, + world, + mockView, + function(shouldStop) { + if (shouldStop) { + refreshView(onCleanRestart, + fail); + } else { + dispatchEventsInQueue(success, fail); + } + }, + fail); + }; + if (plt.baselib.arity.isArityMatching(racketWorldCallback.racketArity, 3)) { + racketWorldCallback(MACHINE, + world, + mockView, + data, + onGoodWorldUpdate, + fail); + } else { + racketWorldCallback(MACHINE, + world, + mockView, + onGoodWorldUpdate, + fail); + } } else { dispatchingEvents = false; success(); @@ -821,7 +1055,7 @@ }; var wrapFunction = function(proc) { - return function(MACHINE) { + var f = function(MACHINE) { var success = arguments[arguments.length - 2]; var fail = arguments[arguments.length - 1]; var args = [].slice.call(arguments, 1, arguments.length - 2); @@ -831,6 +1065,8 @@ success, fail].concat(args)); }; + f.racketArity = proc.racketArity; + return f; }; @@ -867,12 +1103,27 @@ + + var DomElementOutputPort = function(id) { + this.id = id; + }; + + DomElementOutputPort.prototype = plt.baselib.heir(plt.baselib.ports.OutputPort.prototype); + + DomElementOutputPort.prototype.writeDomNode = function (MACHINE, v) { + $("#" + this.id).append(v); + $(v).trigger({type : 'afterAttach'}); + $('*', v).trigger({type : 'afterAttach'}); + }; + + + ////////////////////////////////////////////////////////////////////// var checkReal = plt.baselib.check.checkReal; var checkString = plt.baselib.check.checkString; var checkSymbolOrString = plt.baselib.check.checkSymbolOrString; - + var checkOutputPort = plt.baselib.check.checkOutputPort; var checkProcedure = plt.baselib.check.checkProcedure; var checkResourceOrView = plt.baselib.check.makeCheckArgumentType( @@ -1102,7 +1353,7 @@ 3, function(MACHINE) { var view = checkMockView(MACHINE, 'view-bind', 0); - var name = checkSymbolOrString(MACHINE, 'view-bind', 1).toString(); + var name = checkSymbolOrString(MACHINE, 'view-bind', 1); var worldF = wrapFunction(checkProcedure(MACHINE, 'view-bind', 2)); return view.bind(name, worldF); }); @@ -1126,6 +1377,95 @@ return view.updateFormValue(value); }); + EXPORTS['view-show'] = makePrimitiveProcedure( + 'view-show', + 1, + function(MACHINE) { + var view = checkMockView(MACHINE, 'view-show', 0); + return view.show(); + }); + + + EXPORTS['view-hide'] = makePrimitiveProcedure( + 'view-hide', + 1, + function(MACHINE) { + var view = checkMockView(MACHINE, 'view-hide', 0); + return view.hide(); + }); + + + + EXPORTS['view-append-child'] = makeClosure( + 'view-append-child', + 2, + function(MACHINE) { + var view = checkMockView(MACHINE, 'view-append-child', 0); + var oldArgcount = MACHINE.argcount; + var x = MACHINE.env[MACHINE.env.length - 2]; + PAUSE(function(restart) { + coerseToDomNode(x, + function(dom) { + restart(function(MACHINE) { + MACHINE.argcount = oldArgcount; + var updatedView = view.appendChild(dom); + finalizeClosureCall(MACHINE, updatedView); + }); + }, + function(err) { + restart(function(MACHINE) { + plt.baselib.exceptions.raise( + MACHINE, + new Error(plt.baselib.format.format( + "unable to translate ~s to dom node: ~a", + [x, exn.message]))); + + }); + }); + }); + }); + + + EXPORTS['view-id'] = makePrimitiveProcedure( + 'view-id', + 1, + function(MACHINE) { + var view = checkMockView(MACHINE, 'view-hide', 0); + return view.id(); + }); + + + + + EXPORTS['on-location-change'] = makePrimitiveProcedure( + 'on-location-change', + 1, + function(MACHINE) { + var onChange = wrapFunction(checkProcedure(MACHINE, 'on-location-change', 0)); + return new EventHandler('on-location-change', + new LocationEventSource(), + onChange); + }); + + + EXPORTS['on-mock-location-change'] = makePrimitiveProcedure( + 'on-mock-location-change', + 1, + function(MACHINE) { + var onChange = wrapFunction(checkProcedure(MACHINE, 'on-mock-location-change', 0)); + return new EventHandler('on-mock-location-change', + new MockLocationEventSource(), + onChange); + }); + + + EXPORTS['open-output-element'] = makePrimitiveProcedure( + 'open-output-element', + 1, + function(MACHINE) { + var id = checkString(MACHINE, 'open-output-element', 0); + return new DomElementOutputPort(id.toString()); + }); diff --git a/web-world/main.rkt b/web-world/main.rkt index 3b4e0c5..b92a6ab 100644 --- a/web-world/main.rkt +++ b/web-world/main.rkt @@ -1,4 +1,7 @@ #lang s-exp "../lang/base.rkt" -(require "impl.rkt") -(provide (all-from-out "impl.rkt")) \ No newline at end of file +(require "impl.rkt" + "event.rkt") + +(provide (all-from-out "impl.rkt") + (all-from-out "event.rkt")) \ No newline at end of file diff --git a/web-world/racket-impl.rkt b/web-world/racket-impl.rkt index 7d0fd05..04d5dbd 100644 --- a/web-world/racket-impl.rkt +++ b/web-world/racket-impl.rkt @@ -1,16 +1,28 @@ #lang racket/base -(provide big-bang initial-view stop-when on-tick to-draw +(provide big-bang initial-view stop-when + on-tick + on-location-change on-mock-location-change + to-draw + ->view view-focus view-left view-right view-up view-down view-text update-view-text view-attr update-view-attr + view-id + view-bind view-form-value update-view-form-value - ) + + view-show + view-hide + view-append-child + + open-output-element) + (define (big-bang world . handlers) (error 'big-bang "Please run in JavaScript context.")) @@ -27,6 +39,22 @@ [(f delay) (error 'on-tick "Please run in JavaScript context.")])) + +(define on-location-change + (case-lambda [(f) + (error 'on-location-change "Please run in JavaScript context.")] + [(f delay) + (error 'on-location-change "Please run in JavaScript context.")])) + + +(define on-mock-location-change + (case-lambda [(f) + (error 'on-mock-location-change "Please run in JavaScript context.")] + [(f delay) + (error 'on-mock-location-change "Please run in JavaScript context.")])) + + + (define (to-draw w) (error 'to-draw "Please run in JavaScript context.")) @@ -67,6 +95,10 @@ (error 'update-view-attr "Please run in JavaScript context.")) +(define (view-id v) + (error 'view-id "Please run in JavaScript context.")) + + (define (view-bind v type worldF) (error 'view-bind "Please run in JavaScript context.")) @@ -75,3 +107,18 @@ (define (update-view-form-value val) (error 'view-form-value "Please run in JavaScript context.")) + + +(define (view-show) + (error 'view-show "Please run in JavaScript context.")) + +(define (view-hide) + (error 'view-hide "Please run in JavaScript context.")) + + +(define (view-append-child dom) + (error 'view-append "Please run in JavaScript context.")) + + +(define (open-output-element id) + (error 'open-output-element "Please run in JavaScript context."))