From fa91db7eb4859769d3713a64fe082decd2e79db7 Mon Sep 17 00:00:00 2001
From: darrencruse <darren.cruse@gmail.com>
Date: Thu, 1 Jan 2015 19:31:36 -0600
Subject: [PATCH] allow on-release in world big-bang programs

---
 whalesong/world/js-impl.js      |  9 +++++++++
 whalesong/world/kernel.js       | 16 ++++++++++++++++
 whalesong/world/main.rkt        |  1 +
 whalesong/world/racket-impl.rkt |  4 ++++
 whalesong/world/raw-jsworld.js  | 22 +++++++++++++++++++++-
 5 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/whalesong/world/js-impl.js b/whalesong/world/js-impl.js
index 0831f62..b32c3ce 100644
--- a/whalesong/world/js-impl.js
+++ b/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',
diff --git a/whalesong/world/kernel.js b/whalesong/world/kernel.js
index 9e71ee8..2a283d5 100644
--- a/whalesong/world/kernel.js
+++ b/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;
diff --git a/whalesong/world/main.rkt b/whalesong/world/main.rkt
index 7d9845d..d1e2b84 100644
--- a/whalesong/world/main.rkt
+++ b/whalesong/world/main.rkt
@@ -16,6 +16,7 @@
  #:provided-values (big-bang
                     on-tick
                     on-key
+                    on-release
                     on-mouse
                     key=?
                     to-draw
diff --git a/whalesong/world/racket-impl.rkt b/whalesong/world/racket-impl.rkt
index bac4fab..25ac53e 100644
--- a/whalesong/world/racket-impl.rkt
+++ b/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"))
 
diff --git a/whalesong/world/raw-jsworld.js b/whalesong/world/raw-jsworld.js
index dd406cb..26f801e 100644
--- a/whalesong/world/raw-jsworld.js
+++ b/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