on-key is doing something reasonable

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

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}
 @;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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 ""]))
+
+
+
+
 
 
 

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();
+        });
 
 
 

world/kernel.js

@@ -27,7 +27,8 @@ var bigBang = function(MACHINE, initW, handlers) {
 
     var oldArgcount = MACHINE.argcount;
 
-    var toplevelNode = $('<span/>').css('border', '0px').appendTo(document.body).get(0);
+    var toplevelNode = $('<span/>').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) {
 
 
 
+
+
+
+
+
+

world/main.rkt

@@ -15,6 +15,8 @@
                )
  #:provided-values (big-bang
                     on-tick
+                    on-key
+                    key=?
                     to-draw
                     stop-when))
 

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

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); 
+                }
 	    };
 	}
     }