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

Merge remote-tracking branch 'origin/master'

Browse Source
This commit is contained in:
Danny Yoo 2011-09-16 11:50:35 -04:00
commit 429bab013e
13 changed files with 551 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
info.rkt
View File

@ -2,8 +2,8 @@
(define name "Whalesong")
(define blurb '("A Racket to JavaScript compiler"))
(define release-notes '((p "A not-even-alpha release; please don't use this unless you expect sharp edges...")))
(define version "0.03")
(define release-notes '((p "Starting to stabilize. Fixed several browser compatiblity issues, reduced size of .js files, and added more features to the web-world library")))
(define version "0.04")
(define categories '(devtools))
(define repositories '("4.x"))
(define required-core-version "5.1.1")
@ -22,5 +22,6 @@
(define compile-omit-paths '("tests"
"examples"
"experiments"
"simulator"))
"simulator"
"tmp"))
(define can-be-loaded-with 'all)

2
js-assembler/assemble.rkt
View File

@ -66,7 +66,7 @@ for (param in params) {
}
EOF
op)
(fprintf op "M.trampoline(~a); })"
(fprintf op "M.trampoline(~a, true); })"
(assemble-label (make-Label (BasicBlock-name (first basic-blocks))))))

215
js-assembler/package.rkt
View File

@ -30,7 +30,7 @@
(provide package
package-anonymous
;;package-anonymous
package-standalone-xhtml
get-inert-code
get-standalone-code
@ -77,14 +77,14 @@
(define (package-anonymous source-code
#:should-follow-children? should-follow?
#:output-port op)
(fprintf op "(function() {\n")
(package source-code
#:should-follow-children? should-follow?
#:output-port op)
(fprintf op " return invoke; })\n"))
;; (define (package-anonymous source-code
;; #:should-follow-children? should-follow?
;; #:output-port op)
;; (fprintf op "(function() {\n")
;; (package source-code
;; #:should-follow-children? should-follow?
;; #:output-port op)
;; (fprintf op " return invoke; })\n"))
@ -236,7 +236,8 @@ M.modules[~s] =
;; load in modules.
(define (package source-code
#:should-follow-children? should-follow?
#:output-port op)
#:output-port op
#:next-file-path (next-file-path (lambda () (error 'package))))
(define resources (set))
@ -253,30 +254,53 @@ M.modules[~s] =
src]))
(define (maybe-with-fresh-file thunk)
(cond
[(current-one-module-per-file?)
(define old-port op)
(define temp-string (open-output-string))
(set! op temp-string)
(thunk)
(set! op old-port)
(call-with-output-file (next-file-path)
(lambda (op)
(display (compress (get-output-string temp-string)) op))
#:exists 'replace)]
[else
(thunk)]))
(define (on-visit-src src ast stmts)
;; Record the use of resources on source module visitation...
(set! resources (set-union resources (list->set (source-resources src))))
(fprintf op "\n// ** Visiting ~a\n" (source-name src))
(define start-time (current-inexact-milliseconds))
(cond
[(UninterpretedSource? src)
(fprintf op "~a" (UninterpretedSource-datum src))]
[else
(fprintf op "(")
(assemble/write-invoke stmts op)
(fprintf op ")(M,
(maybe-with-fresh-file
(lambda ()
(fprintf op "\n// ** Visiting ~a\n" (source-name src))
(define start-time (current-inexact-milliseconds))
(cond
[(UninterpretedSource? src)
(fprintf op "(function(M) { ~a }(plt.runtime.currentMachine));" (UninterpretedSource-datum src))]
[else
(fprintf op "(")
(assemble/write-invoke stmts op)
(fprintf op ")(plt.runtime.currentMachine,
function() {
if (window.console && window.console.log) {
window.console.log('loaded ' + ~s);
}
},
FAIL,
PARAMS);"
(format "~a" (source-name src)))
(define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) " assembly: ~s milliseconds\n" (- stop-time start-time))
(void)]))
function(err) {
if (window.console && window.console.log) {
window.console.log('error: unable to load ' + ~s);
}
},
{});"
(format "~a" (source-name src))
(format "~a" (source-name src)))
(define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) " assembly: ~s milliseconds\n" (- stop-time start-time))
(void)]))))
(define (after-visit-src src)
@ -284,7 +308,7 @@ M.modules[~s] =
(define (on-last-src)
(fprintf op "plt.runtime.setReadyTrue(); SUCCESS();"))
(void))
@ -303,13 +327,8 @@ M.modules[~s] =
;; last
on-last-src))
(fprintf op "var invoke = (function(M, SUCCESS, FAIL, PARAMS) {")
(fprintf op " plt.runtime.ready(function() {")
(fprintf op " plt.runtime.setReadyFalse();")
(make (list (make-MainModuleSource source-code))
packaging-configuration)
(fprintf op " });");
(fprintf op "});\n")
(for ([r resources])
((current-on-resource) r)))
@ -322,7 +341,8 @@ M.modules[~s] =
(display *header* op)
(display (quote-cdata
(string-append (get-runtime)
(get-inert-code source-code)
(get-inert-code source-code
(lambda () (error 'package-standalone-xhtml)))
invoke-main-module-code)) op)
(display *footer* op))
@ -404,8 +424,8 @@ EOF
)
;; get-html-template: string -> string
(define (get-html-template js)
;; get-html-template: (listof string) -> string
(define (get-html-template js-files)
(format #<<EOF
<!DOCTYPE html>
<html>
@ -414,7 +434,7 @@ EOF
<meta charset="utf-8"/>
<title></title>
</head>
<script src="~a"></script>
~a
<script>
~a
</script>
@ -424,17 +444,20 @@ EOF
</html>
EOF
js
invoke-main-module-code
))
(string-join (map (lambda (js)
(format " <script src='~a'></script>\n" js))
js-files)
"")
invoke-main-module-code))
;; get-inert-code: source -> string
(define (get-inert-code source-code)
;; get-inert-code: source (-> path) -> string
(define (get-inert-code source-code next-file-path)
(let ([buffer (open-output-string)])
(package source-code
#:should-follow-children? (lambda (src) #t)
#:output-port buffer)
#:output-port buffer
#:next-file-path next-file-path)
(compress
(get-output-string buffer))))
@ -450,10 +473,10 @@ EOF
;; write-standalone-code: source output-port -> void
(define (write-standalone-code source-code op)
(package-anonymous source-code
#:should-follow-children? (lambda (src) #t)
#:output-port op)
(fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n"))
(package source-code
#:should-follow-children? (lambda (src) #t)
#:output-port op))
@ -463,66 +486,56 @@ EOF
#<<EOF
var invokeMainModule = function() {
var M = plt.runtime.currentMachine;
invoke(M,
function() {
var startTime = new Date().valueOf();
plt.runtime.invokeMains(
M,
function() {
// On main module invokation success:
var stopTime = new Date().valueOf();
if (window.console && window.console.log) {
window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
}
},
function(M, e) {
var contMarkSet, context, i, appName;
// On main module invokation failure
if (window.console && window.console.log) {
window.console.log(e.stack || e);
}
var startTime = new Date().valueOf();
plt.runtime.invokeMains(
M,
function() {
// On main module invokation success:
var stopTime = new Date().valueOf();
if (window.console && window.console.log) {
window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
}
},
function(M, e) {
var contMarkSet, context, i, appName;
// On main module invokation failure
if (window.console && window.console.log) {
window.console.log(e.stack || e);
}
M.params.currentErrorDisplayer(
M, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));
M.params.currentErrorDisplayer(
M, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));
if (e.hasOwnProperty('racketError') &&
plt.baselib.exceptions.isExn(e.racketError)) {
contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
if (contMarkSet) {
context = contMarkSet.getContext(M);
for (i = 0; i < context.length; i++) {
if (plt.runtime.isVector(context[i])) {
M.params.currentErrorDisplayer(
M,
$('<div/>').text(' at ' + context[i].elts[0] +
', line ' + context[i].elts[2] +
', column ' + context[i].elts[3])
.addClass('stacktrace')
.css('margin-left', '10px')
.css('whitespace', 'pre')
.css('color', 'red'));
} else if (plt.runtime.isProcedure(context[i])) {
M.params.currentErrorDisplayer(
M,
$('<div/>').text(' in ' + context[i].displayName)
.addClass('stacktrace')
.css('margin-left', '10px')
.css('whitespace', 'pre')
.css('color', 'red'));
}
}
}
if (e.hasOwnProperty('racketError') &&
plt.baselib.exceptions.isExn(e.racketError)) {
contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
if (contMarkSet) {
context = contMarkSet.getContext(M);
for (i = 0; i < context.length; i++) {
if (plt.runtime.isVector(context[i])) {
M.params.currentErrorDisplayer(
M,
$('<div/>').text(' at ' + context[i].elts[0] +
', line ' + context[i].elts[2] +
', column ' + context[i].elts[3])
.addClass('stacktrace')
.css('margin-left', '10px')
.css('whitespace', 'pre')
.css('color', 'red'));
} else if (plt.runtime.isProcedure(context[i])) {
M.params.currentErrorDisplayer(
M,
$('<div/>').text(' in ' + context[i].displayName)
.addClass('stacktrace')
.css('margin-left', '10px')
.css('whitespace', 'pre')
.css('color', 'red'));
}
})},
function() {
// On module loading failure
if (window.console && window.console.log) {
window.console.log(e.stack || e);
}
},
{});
}
}
}
});
};
$(document).ready(invokeMainModule);
EOF
)

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

@ -694,7 +694,7 @@
'substring',
makeList(2, 3),
function(M) {
var str = String(checkString(M, 'substring', 0));
var str = checkString(M, 'substring', 0).toString();
var start = baselib.numbers.toFixnum(checkNatural(M, 'substring', 1));
var end = str.length;
if (M.a === 3) {
@ -1722,8 +1722,8 @@
var i;
if (M.a === 1) {
var sym = checkSymbol(M, 'error', 1);
raise(M, baselib.exceptions.makeExnFail(String(sym),
M.captureContinuationMarks()));
raise(M, baselib.exceptions.makeExnFail(sym.toString(),
M.captureContinuationMarks()));
}
if (isString(M.e[M.e.length - 1])) {
@ -1731,7 +1731,7 @@
for (i = 1; i < M.a; i++) {
vs.push(baselib.format.format("~e", [M.e[M.e.length - 1 - i]]));
}
raise(M, baselib.exceptions.makeExnFail(String(M.e[M.e.length - 1]) +
raise(M, baselib.exceptions.makeExnFail(M.e[M.e.length - 1].toString() +
": " +
vs.join(' '),
M.captureContinuationMarks()));
@ -1744,7 +1744,7 @@
args.push(M.e[M.e.length - 1 - i]);
}
raise(M, baselib.exceptions.makeExnFail(
baselib.format.format('~s: ' + String(fmtString),
baselib.format.format('~s: ' + fmtString.toString(),
args),
M.captureContinuationMarks()));
}
@ -1850,7 +1850,7 @@
var predicateValue =
makePrimitiveProcedure(
String(name) + "?",
name.toString() + "?",
1,
function (M) {
return structType.predicate(M.e[M.e.length - 1]);
@ -1858,7 +1858,7 @@
var accessorValue =
makePrimitiveProcedure(
String(name) + "-accessor",
name.toString() + "-accessor",
2,
function (M) {
return structType.accessor(
@ -1869,7 +1869,7 @@
var mutatorValue =
makePrimitiveProcedure(
String(name) + "-mutator",
name.toString() + "-mutator",
3,
function (M) {
return structType.mutator(
@ -1913,7 +1913,7 @@
var index = M.e[M.e.length - 2];
var name;
if (M.a === 3) {
name = String(M.e[M.e.length - 3]);
name = M.e[M.e.length - 3].toString();
} else {
name = 'field' + index;
}
@ -1940,7 +1940,7 @@
var index = M.e[M.e.length - 2];
var name;
if (M.a === 3) {
name = String(M.e[M.e.length - 3]);
name = M.e[M.e.length - 3].toString();
} else {
name = 'field' + index;
}

13
js-assembler/runtime-src/runtime.js
View File

@ -443,7 +443,7 @@
};
Machine.prototype.trampoline = function(initialJump) {
Machine.prototype.trampoline = function(initialJump, noJumpingOff) {
var thunk = initialJump;
var startTime = (new Date()).valueOf();
this.cbt = STACK_LIMIT_ESTIMATE;
@ -480,6 +480,13 @@
thunk = e;
this.cbt = STACK_LIMIT_ESTIMATE;
// If we're running an a model that prohibits
// jumping off the trampoline, continue.
if (noJumpingOff) {
continue;
}
if (this.params.numBouncesBeforeYield-- < 0) {
recomputeMaxNumBouncesBeforeYield(
this,
@ -506,9 +513,7 @@
}
this.running = false;
var that = this;
setTimeout(
function() { that.params.currentSuccessHandler(that); },
0);
this.params.currentSuccessHandler(this);
return;
};

6
lang/whalesong.rkt
View File

@ -29,7 +29,9 @@
shared
(all-from-out "bool.rkt")
(except-out (all-from-out "check-expect/check-expect.rkt")
run-tests))
run-tests)
λ)
@ -41,6 +43,8 @@
(run-tests)))]))
(define-syntax λ (make-rename-transformer #'lambda))
(define-syntax (my-define-struct stx)
(syntax-case stx ()

51
notes/phonegap-stuff.txt Normal file
View File

@ -0,0 +1,51 @@
Seeing how to use the new Phonegap. I first create a directory for android with the
following:
Say that I'm trying to package where-am-i.rkt.
$ android create project --target "android-8" --name WhereAmI --path where-am-i --activity WhereAmI --package org.plt
I go into the created directory and make an assets subdirectory:
$ cd where-am-i
~/where-am-i $ mkdir -p assets
I then build my where-am-i stuff into assets:
$ cd assets
$ cp ~/work/whalesong/web-world/examples/where-am-i/* .
$ whalesong build --compress-javascript where-am-i.rkt
One problem that's coming up is that the assets file isn't allowed to
have files larger than a megabyte. So I'm forced to split up the
files, after
all... (http://ponystyle.com/blog/2010/03/26/dealing-with-asset-compression-in-android-apps/)
Also, we need to bump utp the loadUrlTimeoutValue parameter to prevent
the browser from timing out from reading the files.
//////////////////////////////////////////////////////////////////////
package org.plt;
import android.os.Bundle;
import com.phonegap.*;
public class WhereAmI extends DroidGap
{
/** Called when the activity is first created. */
@Override
public void onCreate(Bundle savedInstanceState)
{
super.onCreate(savedInstanceState);
// setContentView(R.layout.main);
super.setIntegerProperty("loadUrlTimeoutValue", 60000);
super.loadUrl("file:///android_asset/where-am-i.html");
}
}
//////////////////////////////////////////////////////////////////////

8
parameters.rkt
View File

@ -16,8 +16,10 @@
current-root-path
current-warn-unimplemented-kernel-primitive
current-seen-unimplemented-kernel-primitives
current-kernel-module-locator?
current-compress-javascript?
current-one-module-per-file?
current-report-port
current-timing-port
@ -74,6 +76,12 @@
(define current-compress-javascript? (make-parameter #f))
;; Turn this one so that js-assembler/package generates a file per module, as
;; opposed to trying to bundle them all together.
(: current-one-module-per-file? (Parameterof Boolean))
(define current-one-module-per-file? (make-parameter #f))
(: current-report-port (Parameterof Output-Port))

379
scribblings/manual.scrbl
View File

@ -3,6 +3,7 @@
planet/version
planet/resolver
scribble/eval
scribble/bnf
racket/sandbox
racket/port
racket/list
@ -98,7 +99,6 @@ The GitHub source repository to Whalesong can be found at
@url{https://github.com/dyoo/whalesong}.
Prerequisites: at least @link["http://racket-lang.org/"]{Racket
5.1.1}. If you wish to use the JavaScript compression option,
you will need @link["http://www.java.com"]{Java 1.6} SDK.
@ -112,6 +112,79 @@ Prerequisites: at least @link["http://racket-lang.org/"]{Racket
@subsection{Examples}
Here are a collection of programs that use the @emph{web-world} library described
later in this document:
@itemize[
@item{@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.html"]{attr-animation.html} [@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.rkt"]{src}] Uses @racket[update-view-attr] and @racket[on-tick] to perform a simple color animation.}
@item{@link["http://hashcollision.org/whalesong/examples/boid/boid.html"]{boid.html} [@link["http://hashcollision.org/whalesong/examples/boid/boid.rkt"]{src}] Uses @racket[update-view-css] and @racket[on-tick] to perform an animation of a flock of @link["http://en.wikipedia.org/wiki/Boids"]{boids}.}
@item{@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.html"]{dwarves.html}
[@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.rkt"]{src}]
Uses @racket[view-show] and @racket[view-hide] to manipulate a view. Click on a dwarf to make them hide.
}
@item{@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.html"]{dwarves-with-remove.html}
[@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.rkt"]{src}]
Uses @racket[view-focus?] and @racket[view-remove] to see if a dwarf should be removed from the view.
}
@item{@link["http://hashcollision.org/whalesong/examples/field/field.html"]{field.html}
[@link["http://hashcollision.org/whalesong/examples/field/field.rkt"]{src}]
Uses @racket[view-bind] to read a text field, and @racket[update-view-text] to change
the text content of an element.
}
@item{@link["http://hashcollision.org/whalesong/examples/phases/phases.html"]{phases.html}
[@link["http://hashcollision.org/whalesong/examples/phases/phases.rkt"]{src}]
Switches out one view entirely in place of another. Different views can correspond to phases in a program.
}
@item{@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.html"]{tick-tock.html}
[@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.rkt"]{src}]
Uses @racket[on-tick] to show a timer counting up.
}
@item{@link["http://hashcollision.org/whalesong/examples/redirected/redirected.html"]{redirected.html}
[@link["http://hashcollision.org/whalesong/examples/redirected/redirected.rkt"]{src}]
Uses @racket[on-tick] to show a timer counting up, and also uses @racket[open-output-element] to
pipe side-effecting @racket[printf]s to a hidden @tt{div}.
}
@item{@link["http://hashcollision.org/whalesong/examples/todo/todo.html"]{todo.html}
[@link["http://hashcollision.org/whalesong/examples/todo/todo.rkt"]{src}]
A simple TODO list manager.
}
@item{@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.html"]{where-am-i.html}
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
}
]
I also gave a
@link["http://hashcollision.org/whalesong/racketcon"]{presentation}
of Whalesong at RacketCon 2011, including examples like:
@itemize[
@item{@link["http://hashcollision.org/whalesong/racketcon/rain.html"]{rain.html}
[@link["http://hashcollision.org/whalesong/racketcon/rain.rkt"]{src}]
Uses the image libraries to show droplets of water falling down.}
@item{@link["http://hashcollision.org/whalesong/racketcon/pacman.html"]{pacman.html}
[@link["http://hashcollision.org/whalesong/racketcon/pacman.rkt"]{src}]
Pacman.}
]
@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@section{Getting started}
@ -122,13 +195,23 @@ Prerequisites: at least @link["http://racket-lang.org/"]{Racket
At the time of this writing, although Whalesong has been deployed to
@link["http://planet.racket-lang.org"]{PLaneT}, the version on PLaneT
is out of date. I'll be updating the PLaneT package as soon as
Whalesong starts to stabilize, but the system as a whole is still in
some flux.
is probably a little out of date.
You may want to get the latest sources instead of using the version on
PLaneT. Doing so requires doing a little bit of manual work. The
steps are:
If you want to use Whalesong off of PLaneT, run the following to create
the @filepath{whalesong} launcher:
@codeblock|{
#lang racket/base
(require (planet dyoo/whalesong:1:3/make-launcher))
}|
This will create a @filepath{whalesong} launcher in the current directory.
@subsection{Installing Whalesong from github}
Otherwise, you can download the sources from the github repository.
Doing so requires doing a little bit of manual work. The steps are:
@itemlist[
@item{Check Whalesong out of Github.}
@ -147,9 +230,9 @@ Next, let's set up a @link["http://docs.racket-lang.org/planet/Developing_Packag
parent directory that contains the @filepath{whalesong} repository, and
then run this on your command line:
@verbatim|{
$ planet link dyoo whalesong.plt 1 0 whalesong
$ planet link dyoo whalesong.plt 1 4 whalesong
}|
(You may need to adjust the @tt{1} and @tt{0} major/minor numbers a bit to be larger
(You may need to adjust the @tt{1} and @tt{4} major/minor numbers a bit to be larger
than the latest version that's on PLaneT at the time.)
@ -165,7 +248,7 @@ Finally, we need to set up Whalesong with @tt{raco setup}.
Here's how to do this at the command
line:
@verbatim|{
$ raco setup -P dyoo whalesong.plt 1 0
$ raco setup -P dyoo whalesong.plt 1 4
}|
This should compile Whalesong. Any time the source code in
@filepath{whalesong} changes, we should repeat this @tt{raco setup}
@ -407,9 +490,11 @@ pass the name of the file to it:
}|
A @filepath{.html} and @filepath{.js} will be written to the current directory, as will any external resources that the program uses.
Almost all of the @tt{whalesong} commands support two command line options:
@itemize{
The @tt{whalesong} commands support these command line options:
@itemize[
@item{@verbatim{--compress-javascript} Use Google Closure's JavaScript
compiler to significantly compress the JavaScript. Using this
@ -418,7 +503,13 @@ currently requires a Java 1.6 JDK.}
@item{@verbatim{--verbose} Write verbose debugging information to standard error.}
@item{@verbatim{--dest-dir} Write files to a separate directory, rather than the current directory.}
}
@item{@verbatim{--split-modules} Write each dependent module as a
separate file, rather than in one large @filepath{.js}. This may be
necessary if your browser environment prohibits large @filepath{.js}
files. The files will be numbered starting from @racket[1].}
]
@ -452,17 +543,6 @@ All main modules will be executed when the JavaScript function
@tt{plt.runtime.invokeMains()} is called.
@subsection{@tt{write-javascript-files}}
[NOT DONE YET]
(needs to write a MANIFEST file?)
(this almost seems like we need some concept of a JAR... )
@subsection{@tt{write-resources}}
[NOT DONE YET]
@subsection{@tt{get-runtime}}
Prints out the core runtime library that the files generated by
@ -504,6 +584,22 @@ which defines a variable named @racket[humpback.png] whose
@tech{resource} is @filepath{humpback.png}.
If the resource given has an extension one of the following:
@itemize[
@item{@filepath{.png}}
@item{@filepath{.gif}}
@item{@filepath{.jpg}}
@item{@filepath{.jpeg}}]
then it can be treated as an image for which @racket[image?] will be true.
If the resource has the extension @filepath{.html}, then it will be
run through an HTML purifying process to make sure the HTML is
well-formed.
@defproc[(resource? [x any]) boolean]{
Returns @racket[#t] if @racket[x] is a @tech{resource}.}
@defproc[(resource->url [a-resource resource?]) string?]{
Given a @tech{resource}, gets a URL.
@ -621,59 +717,6 @@ 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]).}
]
@subsection{More web-world examples}
Here are a collection of web-world demos:
@itemize[
@item{@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.html"]{attr-animation.html} [@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.rkt"]{src}] Uses @racket[update-view-attr] and @racket[on-tick] to perform a simple color animation.}
@item{@link["http://hashcollision.org/whalesong/examples/boid/boid.html"]{boid.html} [@link["http://hashcollision.org/whalesong/examples/boid/boid.rkt"]{src}] Uses @racket[update-view-css] and @racket[on-tick] to perform an animation of a flock of @link["http://en.wikipedia.org/wiki/Boids"]{boids}.}
@item{@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.html"]{dwarves.html}
[@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.rkt"]{src}]
Uses @racket[view-show] and @racket[view-hide] to manipulate a view. Click on a dwarf to make them hide.
}
@item{@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.html"]{dwarves-with-remove.html}
[@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.rkt"]{src}]
Uses @racket[view-focus?] and @racket[view-remove] to see if a dwarf should be removed from the view.
}
@item{@link["http://hashcollision.org/whalesong/examples/field/field.html"]{field.html}
[@link["http://hashcollision.org/whalesong/examples/field/field.rkt"]{src}]
Uses @racket[view-bind] to read a text field, and @racket[update-view-text] to change
the text content of an element.
}
@item{@link["http://hashcollision.org/whalesong/examples/phases/phases.html"]{phases.html}
[@link["http://hashcollision.org/whalesong/examples/phases/phases.rkt"]{src}]
Switches out one view entirely in place of another. Different views can correspond to phases in a program.
}
@item{@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.html"]{tick-tock.html}
[@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.rkt"]{src}]
Uses @racket[on-tick] to show a timer counting up.
}
@item{@link["http://hashcollision.org/whalesong/examples/redirected/redirected.html"]{redirected.html}
[@link["http://hashcollision.org/whalesong/examples/redirected/redirected.rkt"]{src}]
Uses @racket[on-tick] to show a timer counting up, and also uses @racket[open-output-element] to
pipe side-effecting @racket[printf]s to a hidden @tt{div}.
}
@item{@link["http://hashcollision.org/whalesong/examples/todo/todo.html"]{todo.html}
[@link["http://hashcollision.org/whalesong/examples/todo/todo.rkt"]{src}]
A simple TODO list manager.
}
@item{@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.html"]{where-am-i.html}
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
}
]
@subsection{@racket[big-bang] and its options}
@ -842,9 +885,29 @@ Move the focus to the parent.}
@defproc[(view-down? [v view]) boolean]{
See if the view can be moved to the first child.
}
@defproc[(view-down [v view]) view]{
Move the view to the first child.}
@defproc[(view-forward? [v view]) boolean]{
See if the view can be moved forward.}
@defproc[(view-forward [v view]) view]{
Move the view forward, assuming a pre-order traversal.
}
@defproc[(view-backward? [v view]) boolean]{
See if the view can be moved backward.}
@defproc[(view-backward [v view]) view]{
Move the view backward, assuming a pre-order traversal.
}
@defproc[(view-text [v view]) string]{
Get the textual content at the focus.
}
@ -893,8 +956,32 @@ 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.}
Dom nodes can be created by using @racket[xexp->dom], which converts a
@tech{xexp} to a node, and attached to the view by using
@racket[view-append-child], @racket[view-insert-left], and
@racket[view-insert-right].
@defproc[(view-append-child [v view] [d dom]) view]{
Add the dom node @racket[d] as the last child of the focused node.
Focus moves to the inserted node.}
@defproc[(view-insert-left [v view] [d dom]) view]{
Add the dom node @racket[d] as the previous sibling of the focused node.
Focus moves to the inserted node.}
@defproc[(view-insert-right [v view] [d dom]) view]{
Add the dom node @racket[d] as the next sibling of the focused node.
Focus moves to the inserted node.}
@defproc[(view-remove [v view]) view]{
Remove the dom node at the focus from the view @racket[v]. Focus tries to move
@ -925,6 +1012,100 @@ Get an list of the event's keys.
@subsection{Dynamic DOM generation with xexps}
@declare-exporting/this-package[web-world]
We often need to dynamically inject new dom nodes into an existing
view. As an example where the UI is entirely in code:
@codeblock|{
#lang planet dyoo/whalesong
(require (planet dyoo/whalesong/web-world))
;; tick: world view -> world
(define (tick world view)
(add1 world))
;; draw: world view -> view
(define (draw world view)
(view-append-child view
(xexp->dom `(p "hello, can you see this? "
,(number->string world)))))
(big-bang 0 (initial-view
(xexp->dom '(html (head) (body))))
(on-tick tick 1)
(to-draw draw))
}|
Normally, we'll want to do as much of the statics as possible with
@filepath{.html} resources, but when nothing else will do, we can
generate DOM nodes programmatically.
We can create new DOMs from an @tech{xexp}, which is a s-expression
representation for a DOM node. Here are examples of expressions that
evaluate to xexps:
@racketblock["hello world"]
@racketblock['(p "hello, this" "is an item")]
@racketblock[
(local [(define name "josh")]
`(p "hello" (i ,name)))]
@racketblock[
'(div (\@ (id "my-div-0"))
(span "This is a span in a div"))]
@racketblock[
`(div (\@ ,(fresh-id))
(span "This is another span in a div whose id is dynamically generated"))]
More formally, a @deftech{xexp} is:
@(let ([open @litchar{(}]
[close @litchar{)}]
[at @litchar[(symbol->string '\@)]])
@BNF[(list @nonterm{xexp}
@nonterm{string}
@nonterm{symbol}
@BNF-seq[open @nonterm{id} @kleenestar[@nonterm{xexp}] close]
@BNF-seq[open @nonterm{id} open at @kleenestar[@nonterm{key-value}] close @kleenestar[@nonterm{xexp}] close])
(list @nonterm{key-value}
@BNF-seq[open @nonterm{symbol} @nonterm{string} close])
])
To check to see if something is a xexp, use @racket[xexp?]:
@defproc[(xexp? [x any]) boolean]{
Return true if @racket[x] is a xexp.
}
@defproc[(xexp->dom [an-xexp xexp]) dom]{
Return a dom from the xexp.
}
When creating xexps, we may need to create unique ids for the nodes.
The web-world library provides a @racket[fresh-id] form to create these.
@defproc[(fresh-id) string]{
Return a string that can be used as a DOM node id.
}
We may also want to take a view and turn it back into an @tech{xexp}.
@defproc[(view->xexp [a-view view]) xexp]{
Coerses a view into a @tech{xexp}.
}
@subsection{Tips and tricks: Hiding standard output or directing it to an element}
@declare-exporting/this-package[web-world]
@ -974,6 +1155,9 @@ even if the id does not currently exist on the page.
@section{The JavaScript Foreign Function Interface}
@defmodule/this-package[js]{
@ -1493,6 +1677,8 @@ language.
@defform[(eq? ...)]{}
@defform[(equal? ...)]{}
@defform[(void ...)]{}
@defform[(quote ...)]{}
@defform[(quasiquote ...)]{}
@ -1650,22 +1836,25 @@ Whalesong by implementing libraries, giving guidence, reporting bugs,
and suggesting improvements.
@;;;;
@; in no particular order... really! I'm shuffling them! :)
@; in alphabetical order
@;;;;
@(apply itemlist
(shuffle (list
@item{Ethan Cecchetti}
@item{Scott Newman}
@item{Zhe Zhang}
@item{Jens Axel Søgaard}
@item{Jay McCarthy}
@item{Sam Tobin-Hochstadt}
@item{Doug Orleans}
@item{Richard Cleis}
@item{Asumu Takikawa}
@item{Eric Hanchrow}
@item{Greg Hendershott}
@item{Shriram Krishnamurthi}
@item{Emmanuel Schanzer}
@item{Robby Findler}))
(map item (sort (list
"Ethan Cecchetti"
"Scott Newman"
"Zhe Zhang"
"Jens Axel Søgaard"
"Jay McCarthy"
"Sam Tobin-Hochstadt"
"Doug Orleans"
"Richard Cleis"
"Asumu Takikawa"
"Eric Hanchrow"
"Greg Hendershott"
"Shriram Krishnamurthi"
"Emmanuel Schanzer"
"Robby Findler"
"Gregor Kiczales"
"Cristina Teodoropol"
) string<?))
)

52
tests/browser-harness.rkt
View File

@ -19,42 +19,38 @@
racket/path
racket/port))
(define first-run #t)
(define evaluate (make-evaluate
(lambda (program op)
(fprintf op "(function () {")
(displayln (get-runtime) op)
(newline op)
(fprintf op "var innerInvoke = ")
(package-anonymous program
#:should-follow-children? (lambda (src) #t)
#:output-port op)
(fprintf op "();\n")
(when first-run
(display (get-runtime) op)
(set! first-run #f))
(fprintf op #<<EOF
return (function(succ, fail, params) {
var machine = new plt.runtime.Machine();
var myParams = { currentDisplayer : function(MACHINE, v) {
params.currentDisplayer(v);
}
};
return innerInvoke(machine,
function() {
plt.runtime.invokeMains(machine, succ, fail);
},
function(MACHINE, e) {
return fail(e);
},
myParams);
});
});
EOF
)
(display "return (function(succ, fail, params) {
var machine = new plt.runtime.Machine();
plt.runtime.currentMachine = machine;" op)
)))
(package program
#:should-follow-children? (lambda (src) #t)
#:output-port op)
(display " machine.params.currentDisplayer = function(MACHINE, v) {
params.currentDisplayer(v);
};
plt.runtime.ready(function() {
plt.runtime.invokeMains(machine,
succ,
function(MACHINE, e) {
fail(e);
});
});
});
});" op))))
;; Flatten the paths out.

2
web-world/impl.rkt
View File

@ -74,9 +74,9 @@
update-view-form-value
view-append-child
view-remove
view-insert-right
view-insert-left
view-remove
xexp?
xexp->dom

49
whalesong-helpers.rkt
View File

@ -85,18 +85,30 @@
(define (build-html-and-javascript f)
(turn-on-logger!)
(define written-js-paths '())
(define make-output-js-filename
(let ([n 0])
(lambda ()
(define result (build-path (current-output-dir)
(regexp-replace #rx"[.](rkt|ss)$"
(path->string (file-name-from-path f))
(if (= n 0)
".js"
(format "_~a.js" n)))))
(set! written-js-paths (cons result written-js-paths))
(set! n (add1 n))
(fprintf (current-report-port)
(format "Writing program ~s\n" result))
result)))
(define start-time (current-inexact-milliseconds))
(let-values ([(base filename dir?)
(split-path f)])
(let ([output-js-filename (build-path
(regexp-replace #rx"[.](rkt|ss)$"
(path->string filename)
".js"))]
[output-html-filename
(build-path
(regexp-replace #rx"[.](rkt|ss)$"
(path->string filename)
".html"))])
(let ([output-html-filename
(build-path
(regexp-replace #rx"[.](rkt|ss)$"
(path->string (file-name-from-path f))
".html"))])
(unless (directory-exists? (current-output-dir))
(fprintf (current-report-port) "Creating destination directory ~s\n" (current-output-dir))
(make-directory* (current-output-dir)))
@ -125,12 +137,11 @@
(copy-file (resource-path r)
(build-path (current-output-dir)
(resource-key r)))]))])
(fprintf (current-report-port)
(format "Writing program ~s\n" (build-path (current-output-dir) output-js-filename)))
(call-with-output-file* (build-path (current-output-dir) output-js-filename)
(call-with-output-file* (make-output-js-filename)
(lambda (op)
(display (get-runtime) op)
(display (get-inert-code (make-ModuleSource (build-path f)))
(display (get-inert-code (make-ModuleSource (build-path f))
make-output-js-filename)
op))
#:exists 'replace)
@ -138,12 +149,14 @@
(format "Writing html ~s\n" (build-path (current-output-dir) output-html-filename)))
(call-with-output-file* (build-path (current-output-dir) output-html-filename)
(lambda (op)
(display (get-html-template output-js-filename) op))
(display (get-html-template
(map file-name-from-path
(reverse written-js-paths)))
op))
#:exists 'replace)
(define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time))
))))
(fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time)))))

3
whalesong.rkt
View File

@ -69,6 +69,9 @@
[("--compress-javascript")
("Compress JavaScript with Google Closure (requires Java)")
(current-compress-javascript? #t)]
[("--split-modules")
("Write one file per module")
(current-one-module-per-file? #t)]
[("--dest-dir")
dest-dir
("Set destination directory (default: current-directory)")