From bac5652706d029c74deb3418a3d764708f78ecff Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 21 Jul 2011 15:20:59 -0400 Subject: [PATCH] on-key is doing something reasonable --- ...world-program.rkt => expanding-circle.rkt} | 0 examples/whale.rkt | 37 +++++++++ images/humpback.jpg | Bin 0 -> 2923 bytes scribblings/manual.scrbl | 23 +++++- scribblings/scribble-helpers.rkt | 21 ++++- world/js-impl.js | 18 ++++ world/kernel.js | 78 +++++++++++++++++- world/main.rkt | 2 + world/racket-impl.rkt | 14 +++- world/raw-jsworld.js | 17 ++-- 10 files changed, 196 insertions(+), 14 deletions(-) rename examples/{counting-world-program.rkt => expanding-circle.rkt} (100%) create mode 100644 examples/whale.rkt create mode 100644 images/humpback.jpg 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 0000000000000000000000000000000000000000..aab9368a7fb7334b0e33228ccd02f1a46248c117 GIT binary patch literal 2923 zcmb7Ac{tRK7XHm*iNr8XnnCuhv5cLNb<7|lsYuy1%-DUCrO1|D_N7VJHg;J@l!c4J0&vFxFna zIKU^!-^EQ!_)cJ;ua<&>iw}w9;~gMRCU_A@Zmt9;c^`idg+G<+#3QC+qqQnFc2w}9an52}9tjyVSa*A@&iW1T?(tn14*x1-O*g5z(IQXQI2&DA? z4Q2-bV+V|YyATiz0K-5K7>L;o2mk;G3IPHC1qc8`j*n$yKW0^V05Av)g+f?aK`j54 zfWQza3}E3EVdcZ@ z!EHeF!wz0ggU7qtP9lybTwhvO=u8K9hOtEMgIIfn*MBXbMUGoj>oJI~D&E9D2`8eO zC1IZvBEYVy?+lK_ZzSl~_Y1TgSQ|^mV(1UKN*}%^{-yhn6H*T-M6hfFbZOvV0TO-_ zSn%WEB|U&Hl+3jp*&+13W3CfT=E8c#-AjYE3B55ix%3zs!W4m!t{K@KY81mgR;x*Q zLUpXi;@*kq8V*iwBn^1#sPk(g&+z*VOA@-8RTT9mCx1+?AmhKX>s3kgX3kgas?~`v z4XmbHGs=H6fsD6>&{tBZJ=Lv)mSzsE`zRm3LD4kXsw7X-mpsiQRq5W{YizAy-l*)P zOOuw@5p*3B3bIa^(-E)$>}n?M!86TCEQ!}UxI7T8ZbH{IV$&5H&F8n*AU3l3?nswR zz)td;u4h;q*e6x!#!F3jj>HiYcutPC#a;QTL^Q%Otyx@+Z=U%S+8nDfyd)x{FO@g7ued$UYKKJT zoA~_RnAP{dn}CfeDXJBP*o5RL3Dp|M9Qlm%*@qR5 z6C`uFRvm8pM3S>ybKS|+A4*NhHJ?u{@BQA25}Cf294fAT#ZoA=8+_-RgR8zJzsNe8 zyc33*cgC*z%6X;C)CZHcS2H9CLU}kS#ssc1SMH)O;Mbdf70$^5sRKa7kg*k~6T)-Y zr9%rDsL_+D-?^aD+j}h&fJ*FU8Q^bfcw3Z_cMIoWmt7ctZmB9fTUpB39$mij$dk3m zabasHYj2CBd%a67c2Le7=TUAKg`D~4xWlt=Y6p%dy@T+!+I==q&lU4ddOocKap0yO zB_};)jct@~i;qIZwME-MX%4#Bt9{_+|I8%JGb_KWiE{Ksn#V-@(Xc=#?-K$I7rQbW z+x_9*r6a$Q;j!N5FXGSWh6I@!$5d>(}$sCR4m%y zfg{V`AO`OMsbEw?%R;o$v$At=KqhrXlcc?Z`Zmb~+!@@~mp>0aLXit+b z`!xTU3#{9_{=qU!4ej;JUhzOL(k&N?FG{$EkM?=h=L} z6!C|#wZ_wCA%&8(*eeFkLsf+0<;hhfBS&oR>#|8*%T*=SL9Pym`gBT%3>r>`1hmu& zs}(>#o!Ebh0X5g&<|+t=dw;}H=gU*eZhG^4b9YmKlZ!KZj5GVpjE##5Bqos9YT$S1 zQ)Mqoi1RvbxBYvy3bCP&nqH2R?~WJOg}w7Q7f#oDKN9Dziu^v)*`DQEq1YU^{T+&0 zTzibN$#*`FR+WtkTG-IzOZhd^Z`+g+n z@(7Yg3724+&|6p`8Du|)5VNf!%?TJ}m}RDt!~ZH7EYOp8vcs#<7r4y9!QWqvBKonN zaFtdYGwo6B6x&5v{2SMEYR+s~-zfnkx>zMXQ1e=oHdQ9iZScGihe|O=`a7|5dP>XI z1YJ{QxI*;A{-{ho{?aKk%6Pq1+ts-XKJ<03AN8oM31|r_UXI0wyFExHtH$1vJuq0j zI=;k4@X!=_gtlNT_V>#bDIk8?hZ>9!xH(rQDN;6Bt=W!x*&&2i%KF=J+0$ymY5qiz z&PJ-LP@?v#eaFqKCJt|EKmFSO?C4-%Sgy8w*L3dOQe6jZ%-4hWU7z}=L!BqnvX3ux z>C4deE_~VYvVXh4ZRk7CDt`@cmScS2&7&-(YP+c?7t}u7g4*i~k~m$Qkx1+xSv#qi z>nVA+DKWCKuN?Jp)~DsSb46PB)YoE?$A_h+>*C;c;-K9-7^aCb<;6wjj%F5 zm;x6i;(55F(CXbT(~QGDF9y3K9F`kL6k@zsFDe|~?hkwIWfD|s&vtWOTX2beFK2K;8& z(w~-Yq*~5)>>dsEmp33yft`uGU?VhDouvPGXztchc&*}gueSOR*P+yV)sba6mN%~O zmPSm7Fae6dok}~2VdaGE5^6##VHYZ`clvVGEaOzf&0iEgLR!gN;o{;*TAoW$Da^(c zwg>|vglG`drTs=Z1#zO`!?lWr{wkP$)&pNntMXgZNE_16ZimxFbSpCf`0AX@+(3sz z;)e@!cV8ZEVrWK9)|78W0*ll~`na)PJ(f==yVIsu%XXZ;BxL0g`wN3F@|m|%b0;up XHq3)7@4R5EANPlzCL>KpneYDv8&VV5 literal 0 HcmV?d00001 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); + } }; } }