suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into web-world

Browse Source
This commit is contained in:
Danny Yoo 2011-08-30 01:16:59 -04:00
commit 12dfe2caa0
21 changed files with 1225 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Makefile
View File

@ -1,8 +1,10 @@
# test-analyzer:
# raco make -v --disable-inline test-analyzer.rkt
# racket test-analyzer.rkt
all: planet-link launcher
launcher:
launcher:
raco make -v --disable-inline whalesong.rkt
racket make-launcher.rkt
@ -44,5 +46,14 @@ doc:
scribble ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs --dest-name index.html scribblings/manual.scrbl
cs19-doc:
scribble ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs scribblings/cs19.scrbl
setup:
raco setup -P dyoo whalesong.plt 1 2
planet-link:
raco planet link dyoo whalesong.plt 1 4 .

9
base/reader/reader.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang s-exp syntax/module-reader
;; http://docs.racket-lang.org/planet/hash-lang-planet.html
#:language (lambda (ip)
`(file ,(path->string base-lang-path)))
(require racket/runtime-path)
(define-runtime-path base-lang-path "../lang/base.rkt")

1
js-assembler/package.rkt
View File

@ -273,7 +273,6 @@ MACHINE.modules[~s] =
;; last
on-last-src))
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(fprintf op " plt.runtime.ready(function() {")
(fprintf op "plt.runtime.setReadyFalse();")

34
js-assembler/runtime-src/baselib-primitives.js
View File

@ -272,6 +272,23 @@
installPrimitiveProcedure(
'current-error-port',
makeList(0, 1),
function (MACHINE) {
if (MACHINE.argcount === 1) {
MACHINE.params['currentErrorPort'] =
checkOutputPort(MACHINE, 'current-output-port', 0);
return VOID;
} else {
return MACHINE.params['currentOutputPort'];
}
});
installPrimitiveProcedure(
@ -1587,7 +1604,6 @@
String(name) + "-accessor",
2,
function (MACHINE) {
// FIXME: typechecks
return structType.accessor(
MACHINE.env[MACHINE.env.length - 1],
baselib.numbers.toFixnum(MACHINE.env[MACHINE.env.length - 2]));
@ -1599,7 +1615,6 @@
String(name) + "-mutator",
3,
function (MACHINE) {
// FIXME: typechecks
return structType.mutator(
MACHINE.env[MACHINE.env.length - 1],
baselib.numbers.toFixnum(MACHINE.env[MACHINE.env.length - 2]),
@ -1637,8 +1652,6 @@
'make-struct-field-accessor',
makeList(2, 3),
function (MACHINE){
// FIXME: typechecks
// We must guarantee that the ref argument is good.
var structType = MACHINE.env[MACHINE.env.length - 1].structType;
var index = MACHINE.env[MACHINE.env.length - 2];
var name;
@ -1647,12 +1660,15 @@
} else {
name = 'field' + index;
}
var checkStruct = baselib.check.makeCheckArgumentType(structType.predicate,
structType.name);
return makePrimitiveProcedure(
name,
1,
function (MACHINE) {
var aStruct = checkStruct(MACHINE, name, 0);
return structType.accessor(
MACHINE.env[MACHINE.env.length - 1],
aStruct,
baselib.numbers.toFixnum(index));
});
@ -1663,8 +1679,6 @@
'make-struct-field-mutator',
makeList(2, 3),
function (MACHINE){
// FIXME: typechecks
// We must guarantee that the set! argument is good.
var structType = MACHINE.env[MACHINE.env.length - 1].structType;
var index = MACHINE.env[MACHINE.env.length - 2];
var name;
@ -1673,19 +1687,21 @@
} else {
name = 'field' + index;
}
var checkStruct = baselib.check.makeCheckArgumentType(structType.predicate,
structType.name);
return makePrimitiveProcedure(
name,
2,
function (MACHINE) {
var aStruct = checkStruct(MACHINE, name, 0);
return structType.mutator(
MACHINE.env[MACHINE.env.length - 1],
aStruct,
baselib.numbers.toFixnum(index),
MACHINE.env[MACHINE.env.length - 2]);
});
});
exports['Primitives'] = Primitives;
exports['installPrimitiveProcedure'] = installPrimitiveProcedure;
exports['installPrimitiveClosure'] = installPrimitiveClosure;

15
lang/base.rkt
View File

@ -5,18 +5,11 @@
;; Don't publically export the bindings from #%paramz.
exception-handler-key
parameterization-key
break-enabled-key
;; Use the traced app
#;#%app)
break-enabled-key)
(all-from-out "private/list.rkt"))
(all-from-out "private/list.rkt")
#;(rename-out [traced-app #%app]))
(require "private/list.rkt"
"private/traced-app.rkt")
(require "private/list.rkt")
;; Kludge: This forces modbeg to be compiled and packaged.
(require racket/private/modbeg)
(require racket/private/modbeg)

4
lang/reader.rkt
View File

@ -3,7 +3,7 @@
;; http://docs.racket-lang.org/planet/hash-lang-planet.html
#:language (lambda (ip)
`(file ,(path->string base-lang-path)))
`(file ,(path->string whalesong-lang-path)))
(require racket/runtime-path)
(define-runtime-path base-lang-path "base.rkt")
(define-runtime-path whalesong-lang-path "whalesong.rkt")

13
lang/whalesong.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang s-exp "kernel.rkt"
(require "base.rkt"
"private/traced-app.rkt")
;; Programs written in Whalesong will have tracing enabled by default.
;; If you don't want this, write in whalesong/base instead.
(provide (except-out (all-from-out "base.rkt")
;;#%app
)
;;(rename-out [traced-app #%app])
)

520
scribblings/cs19.scrbl Normal file
View File

@ -0,0 +1,520 @@
#lang scribble/manual
@(require planet/scribble
planet/version
planet/resolver
scribble/eval
racket/sandbox
racket/port
(only-in racket/contract any/c)
racket/runtime-path
"scribble-helpers.rkt"
"../js-assembler/get-js-vm-implemented-primitives.rkt")
@(require (for-label (this-package-in resource))
(for-label (this-package-in web-world)))
@(define-runtime-path whalesong-path "..")
@title{CS19 instructions for Whalesong}
@author+email["Danny Yoo" "dyoo@hashcollision.org"]
@section{Installation}
We'll install a local development copy of Whalesong in a @filepath{whalesong} subdirectory.
On the very first time we install Whalesong:
@verbatim|{
$ git clone git://github.com/dyoo/whalesong.git
$ cd whalesong
$ make
}|
The @filepath{make} step make take a minute or two, and creates a command-line program called
@filepath{whalesong} that we'll use to build Whalesong programs.
Whenever we need to update whalesong, we should do the following
@verbatim|{
$ git pull
$ make
}|
@section{Usage}
The @filepath{whalesong} launcher in the subdirectory will compile
programs to standalone @filepath{.xhtml} files.
Example usage: using @litchar{whalesong build} to compile a whalesong program.
@verbatim|{
fermi ~/whalesong $ cd examples
fermi ~/whalesong/examples $ cat hello.rkt
#lang planet dyoo/whalesong
(display "hello world")
(newline)
fermi ~/whalesong/examples $ ../whalesong build hello.rkt
fermi ~/whalesong/examples $ google-chrome hello.xhtml
Created new window in existing browser session.
fermi ~/whalesong/examples $
}|
@section{Examples}
There are examples in the
@link["https://github.com/dyoo/whalesong/tree/master/examples"]{@filepath{whalesong/examples}}
and
@link["https://github.com/dyoo/whalesong/tree/master/web-world/examples"]{@filepath{whalesong/web-world/examples}}.
Let's look at a few of them.
@subsection{Hello world}
Let's try making a simple, standalone executable. At the moment, the
program must be written in the base language of @racket[(planet
dyoo/whalesong)]. This restriction unfortunately prevents arbitrary
@racketmodname[racket/base] programs from compiling at the moment;
the developers (namely, dyoo) will be working to remove this
restriction as quickly as possible.
Write a @filepath{hello.rkt} with the following content
@filebox["hello.rkt"]{
@codeblock{
#lang planet dyoo/whalesong
(display "hello world")
(newline)
}}
This program is a regular Racket program, and can be executed normally,
@verbatim|{
$ racket hello.rkt
hello world
$
}|
However, it can also be packaged with @filepath{whalesong}.
@verbatim|{
$ whalesong build hello.rkt
$ ls -l hello.xhtml
-rw-rw-r-- 1 dyoo nogroup 692213 Jun 7 18:00 hello.xhtml
}|
Running @tt{whalesong build} on a Racket program will produce a self-contained
@filepath{.xhtml} file. If we open this file in our favorite web browser,
we should see a triumphant message show on screen.
@subsection{Tick tock}
Let's do something a little more interesting, and create a ticker that
counts on the screen.
The first thing we can do is mock up a web page with a user interface, like this.
@filebox["index.html"]{
@verbatim|{
<html>
<head><title>My simple program</title></head>
<body>
<p>The current counter is: <span id="counter">fill-me-in</span></p>
</body>
</html>
}|
}
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.
}

2
version.rkt
View File

@ -1,4 +1,4 @@
#lang typed/racket/base
(provide version)
(: version String)
(define version "1.0")
(define version "1.0")

25
web-world/event.rkt Normal file
View File

@ -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))]))

53
web-world/examples/dwarves/dwarves.rkt Normal file
View File

@ -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))

16
web-world/examples/dwarves/index.html Normal file
View File

@ -0,0 +1,16 @@
<html>
<head><title>Dwarves</title></head>
<body>
<h1>Dwarfs from Snow White</h1>
<p>Click on a dwarf to make them hide.</p>
<ul id="list">
<li id="Doc">Doc</li>
<li id="Grumpy">Grumpy</li>
<li id="Happy">Happy</li>
<li id="Sleepy">Sleepy</li>
<li id="Bashful">Bashful</li>
<li id="Sneezy">Sneezy</li>
<li id="Dopey">Dopey</li>
</ul>
</body>
</html>

13
web-world/examples/redirected/index.html Normal file
View File

@ -0,0 +1,13 @@
<html>
<head><title>My simple program</title></head>
<body>
<p>The current counter is: <span id="counter">fill-me-in</span></p>
<p>There is content from the <tt>printf</tt> statements going into
the hidden div below:</p>
<!-- This div is hidden. -->
<div id="stdout"
style="border: 1px solid black; display: none " />
</body>
</html>

26
web-world/examples/redirected/redirected.rkt Normal file
View File

@ -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))))

9
web-world/examples/where-am-i/index.html Normal file
View File

@ -0,0 +1,9 @@
<html>
<head><title>Where in the world am I?</title></head>
<body>
<p>
I am at: <span id="real-location">dunno</span>.
The mock location says: <span id="mock-location">dunno</span>.
</p>
</body>
</html>

45
web-world/examples/where-am-i/where-am-i.rkt Normal file
View File

@ -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))

20
web-world/impl.rkt
View File

@ -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
))

3
web-world/info.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang setup/infotab
(define compile-omit-paths '("examples"))

416
web-world/js-impl.js
View File

@ -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 = $("<div/>");
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());
});

7
web-world/main.rkt
View File

@ -1,4 +1,7 @@
#lang s-exp "../lang/base.rkt"
(require "impl.rkt")
(provide (all-from-out "impl.rkt"))
(require "impl.rkt"
"event.rkt")
(provide (all-from-out "impl.rkt")
(all-from-out "event.rkt"))

51
web-world/racket-impl.rkt
View File

@ -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."))