diff --git a/examples/counting-world-program.rkt b/examples/expanding-circle.rkt
similarity index 100%
rename from examples/counting-world-program.rkt
rename to examples/expanding-circle.rkt
diff --git a/examples/whale.rkt b/examples/whale.rkt
new file mode 100644
index 0000000..fe34fe6
--- /dev/null
+++ b/examples/whale.rkt
@@ -0,0 +1,37 @@
+#lang planet dyoo/whalesong
+
+(require (planet dyoo/whalesong/world))
+
+(define-struct world (x direction))
+
+
+(define whale-image (image-url "http://hashcollision.org/whalesong/humpback.jpg"))
+
+(define scene-width (* (image-width whale-image) 5))
+
+(define (draw w)
+ (place-image whale-image
+ (world-x w)
+ (/ (image-height whale-image) 2)
+ (empty-scene scene-width
+ (image-height whale-image))))
+
+(define (tick w)
+ (make-world (modulo (+ (world-x w)
+ (world-direction w))
+ (+ scene-width (image-width whale-image)))
+ (world-direction w)))
+
+
+(define (key w a-key)
+ (cond
+ [(key=? a-key "left")
+ (make-world (world-x w) (sub1 (world-direction w)))]
+ [(key=? a-key "right")
+ (make-world (world-x w) (add1 (world-direction w)))]))
+
+
+(big-bang (make-world 0 5)
+ (on-tick tick)
+ (to-draw draw)
+ (on-key key))
diff --git a/images/humpback.jpg b/images/humpback.jpg
new file mode 100644
index 0000000..aab9368
Binary files /dev/null and b/images/humpback.jpg differ
diff --git a/scribblings/manual.scrbl b/scribblings/manual.scrbl
index c26c69a..28ffc5d 100644
--- a/scribblings/manual.scrbl
+++ b/scribblings/manual.scrbl
@@ -570,12 +570,27 @@ Can only be called in a JavaScript context.
Returns the height of the viewport.
}
-
-
-
-
}
+
+
+@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+@section{World programming}
+@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+Whalesong provides a library to support writing functional I/O
+programs
+(@link["http://www.ccs.neu.edu/scheme/pubs/icfp09-fffk.pdf"]{A
+Functional I/O System}). Here's an example of such a world program:
+
+@inject-empty-span-with-id{simple-world-program}
+[FIXME: embed a world program here.]
+
+
+
+
+
+
@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@section{Internals}
@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/scribblings/scribble-helpers.rkt b/scribblings/scribble-helpers.rkt
index bd6b6d4..9547bfd 100644
--- a/scribblings/scribble-helpers.rkt
+++ b/scribblings/scribble-helpers.rkt
@@ -1,6 +1,8 @@
#lang racket/base
-(provide inject-javascript-inline inject-javascript-src)
+(provide inject-javascript-inline
+ inject-javascript-src
+ inject-empty-span-with-id)
(require scribble/core
scribble/html-properties
@@ -33,6 +35,23 @@
[text ""]))
+(define (inject-empty-span-with-id id)
+ (cond-element
+ [latex ""]
+ [html
+ (make-element
+ (make-style #f
+ (list
+ (make-alt-tag "span")
+ (make-attributes
+ `((id . , id)))))
+ '())]
+
+ [text ""]))
+
+
+
+
diff --git a/world/js-impl.js b/world/js-impl.js
index 6f16849..dbbe937 100644
--- a/world/js-impl.js
+++ b/world/js-impl.js
@@ -5,6 +5,7 @@ var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
var checkNonNegativeReal = plt.baselib.check.checkNonNegativeReal;
+var checkString = plt.baselib.check.checkString;
var checkProcedure = plt.baselib.check.checkProcedure;
@@ -87,7 +88,24 @@ EXPORTS['stop-when'] =
});
+EXPORTS['on-key'] =
+ makePrimitiveProcedure(
+ 'on-key',
+ 1,
+ function(MACHINE) {
+ var f = checkProcedureWithKey(MACHINE, "on-key", 0);
+ return new OnKey(f);
+ });
+EXPORTS['key=?'] =
+ makePrimitiveProcedure(
+ 'on-key',
+ 2,
+ function(MACHINE) {
+ var k1 = checkString(MACHINE, "key=?", 0);
+ var k2 = checkString(MACHINE, "key=?", 1);
+ return k1.toString().toLowerCase() === k2.toString().toLowerCase();
+ });
diff --git a/world/kernel.js b/world/kernel.js
index a74940c..a9421ed 100644
--- a/world/kernel.js
+++ b/world/kernel.js
@@ -27,7 +27,8 @@ var bigBang = function(MACHINE, initW, handlers) {
var oldArgcount = MACHINE.argcount;
- var toplevelNode = $('').css('border', '0px').appendTo(document.body).get(0);
+ var toplevelNode = $('').get(0);
+ MACHINE.params.currentOutputPort.writeDomNode(MACHINE, toplevelNode);
var configs = [];
var isOutputConfigSeen = false;
@@ -158,6 +159,75 @@ OnTick.prototype.toRawHandler = function(MACHINE, toplevelNode) {
};
+//////////////////////////////////////////////////////////////////////
+var OnKey = function(handler) {
+ WorldConfigOption.call(this, 'on-key');
+ this.handler = handler;
+}
+
+OnKey.prototype = plt.baselib.heir(WorldConfigOption.prototype);
+
+OnKey.prototype.toRawHandler = function(MACHINE, toplevelNode) {
+ var that = this;
+ var worldFunction = adaptWorldFunction(that.handler);
+ return rawJsworld.on_key(
+ function(w, e, success) {
+ worldFunction(w, getKeyCodeName(e), success);
+ });
+};
+
+
+var getKeyCodeName = function(e) {
+ var code = e.charCode || e.keyCode;
+ var keyname;
+ switch(code) {
+ case 16: keyname = "shift"; break;
+ case 17: keyname = "control"; break;
+ case 19: keyname = "pause"; break;
+ case 27: keyname = "escape"; break;
+ case 33: keyname = "prior"; break;
+ case 34: keyname = "next"; break;
+ case 35: keyname = "end"; break;
+ case 36: keyname = "home"; break;
+ case 37: keyname = "left"; break;
+ case 38: keyname = "up"; break;
+ case 39: keyname = "right"; break;
+ case 40: keyname = "down"; break;
+ case 42: keyname = "print"; break;
+ case 45: keyname = "insert"; break;
+ case 46: keyname = String.fromCharCode(127); break;
+ case 106: keyname = "*"; break;
+ case 107: keyname = "+"; break;
+ case 109: keyname = "-"; break;
+ case 110: keyname = "."; break;
+ case 111: keyname = "/"; break;
+ case 144: keyname = "numlock"; break;
+ case 145: keyname = "scroll"; break;
+ case 186: keyname = ";"; break;
+ case 187: keyname = "="; break;
+ case 188: keyname = ","; break;
+ case 189: keyname = "-"; break;
+ case 190: keyname = "."; break;
+ case 191: keyname = "/"; break;
+ case 192: keyname = "`"; break;
+ case 219: keyname = "["; break;
+ case 220: keyname = "\\"; break;
+ case 221: keyname = "]"; break;
+ case 222: keyname = "'"; break;
+ default:
+ if (code >= 96 && code <= 105) {
+ keyname = (code - 96).toString();
+ } else if (code >= 112 && code <= 123) {
+ keyname = "f" + (code - 111);
+ } else {
+ keyname = String.fromCharCode(code).toLowerCase();
+ }
+ break;
+ }
+ return keyname;
+}
+//////////////////////////////////////////////////////////////////////
+
@@ -1140,3 +1210,9 @@ StopWhen.prototype.toRawHandler = function(MACHINE, toplevelNode) {
+
+
+
+
+
+
diff --git a/world/main.rkt b/world/main.rkt
index 58e019e..0238a74 100644
--- a/world/main.rkt
+++ b/world/main.rkt
@@ -15,6 +15,8 @@
)
#:provided-values (big-bang
on-tick
+ on-key
+ key=?
to-draw
stop-when))
diff --git a/world/racket-impl.rkt b/world/racket-impl.rkt
index 3f2f163..38d50ca 100644
--- a/world/racket-impl.rkt
+++ b/world/racket-impl.rkt
@@ -3,10 +3,13 @@
(provide big-bang
on-tick
to-draw
+ on-key
+ key=?
stop-when)
-;; Fixme: replace with 2htdp/world stuff
+;; Fixme: the errors below need to be replaced with 2htdp/world-based
+;; implementations.
(define (big-bang initial-world . args)
@@ -20,8 +23,13 @@
(error 'on-tick "not done yet")]))
(define (to-draw handler)
- (error 'on-tick "not done yet"))
+ (error 'to-draw "not done yet"))
+(define (on-key handler)
+ (error 'on-key "not done yet"))
+
+(define (key=? key-1 key-2)
+ (error 'key=? "not done yet"))
(define (stop-when handler)
- (error 'on-tick "not done yet"))
+ (error 'stop-when "not done yet"))
diff --git a/world/raw-jsworld.js b/world/raw-jsworld.js
index cd65907..bb8246e 100644
--- a/world/raw-jsworld.js
+++ b/world/raw-jsworld.js
@@ -897,13 +897,20 @@ var rawJsworld = {};
function on_key(press) {
return function() {
var wrappedPress = function(e) {
- preventDefault(e);
- stopPropagation(e);
- change_world(function(w, k) { press(w, e, k); }, doNothing);
+ preventDefault(e);
+ stopPropagation(e);
+ change_world(function(w, k) { press(w, e, k); }, doNothing);
};
return {
- onRegister: function(top) { attachEvent(top, 'keydown', wrappedPress); },
- onUnregister: function(top) { detachEvent(top, 'keydown', wrappedPress); }
+ onRegister: function(top) {
+ //http://www.w3.org/TR/html5/editing.html#sequential-focus-navigation-and-the-tabindex-attribue
+ $(top).attr('tabindex', 1);
+ $(top).focus();
+ attachEvent(top, 'keydown', wrappedPress);
+ },
+ onUnregister: function(top) {
+ detachEvent(top, 'keydown', wrappedPress);
+ }
};
}
}