allow on-release in world big-bang programs

whalesong/world/js-impl.js

@@ -103,6 +103,15 @@ EXPORTS['on-key'] =
             return new OnKey(f);
         });
 
+EXPORTS['on-release'] =
+    makePrimitiveProcedure(
+        'on-release',
+        1,
+        function(MACHINE) {
+            var f = checkProcedureWithKey(MACHINE, "on-key", 0);
+            return new OnRelease(f);
+        });
+
 EXPORTS['on-mouse'] =
     makePrimitiveProcedure(
         'on-mouse',

whalesong/world/kernel.js

@@ -168,6 +168,22 @@ OnKey.prototype.toRawHandler = function(MACHINE, toplevelNode) {
         });
 };
 
+var OnRelease = function(handler) {
+    WorldConfigOption.call(this, 'on-release');
+    this.handler = handler;
+}
+
+OnRelease.prototype = plt.baselib.heir(WorldConfigOption.prototype);
+ 
+OnRelease.prototype.toRawHandler = function(MACHINE, toplevelNode) {
+    var that = this;
+    var worldFunction = adaptWorldFunction(that.handler);
+    return rawJsworld.on_release(
+        function(w, e, success) {
+            worldFunction(w, getKeyCodeName(e), success);
+        });
+};
+
 
 var getKeyCodeName = function(e) {
     var code = e.charCode || e.keyCode;

whalesong/world/main.rkt

@@ -16,6 +16,7 @@
  #:provided-values (big-bang
                     on-tick
                     on-key
+                    on-release
                     on-mouse
                     key=?
                     to-draw

whalesong/world/racket-impl.rkt

@@ -5,6 +5,7 @@
          on-tick
          on-mouse
          on-key
+         on-release
          key=?
          stop-when)
 
@@ -33,6 +34,9 @@
 (define (on-key handler)
   (error 'on-key "must be run in JavaScript context"))
 
+(define (on-release handler)
+  (error 'on-release "must be run in JavaScript context"))
+
 (define (key=? key-1 key-2)
   (error 'key=? "must be run in JavaScript context"))
 

whalesong/world/raw-jsworld.js

@@ -743,7 +743,27 @@ var rawJsworld = {};
     }
     Jsworld.on_key = on_key;
 
-
+    function on_release(release) {
+        return function() {
+            var wrappedRelease = function(e) {
+                preventDefault(e);
+                stopPropagation(e);
+                change_world(function(w, k) { release(w, e, k); }, doNothing);
+            };
+            return {
+                onRegister: function(top) {
+                    //http://www.w3.org/TR/html5/editing.html#sequential-focus-navigation-and-the-tabindex-attribue
+                    jQuery(top).attr('tabindex', 1);
+                    jQuery(top).focus();
+                    attachEvent(top, 'keyup', wrappedRelease);
+                },
+                onUnregister: function(top) {
+                    detachEvent(top, 'keyup', wrappedRelease);
+                }
+            };
+        };
+    }
+    Jsworld.on_release = on_release;
 
 
     // http://www.quirksmode.org/js/events_mouse.html