@@ -68,3 +68,9 @@ (def eval-these (exprs) (if (acons exprs) (do (eval (car exprs)) (eval-these (cdr exprs))))) + +(mac afnwith (withses . body) + (let w (pair withses) + `((afn ,(map car w) ,@body) ,@(map cadr w)))) + + src/arc/lib/bag-of-tricks.arc @@ -160,8 +160,9 @@ (= ignore (uniq)) (def unescape-fragment (fragment) - (string (accum s - ((afn (chs escaping) + (string:accum s + (afnwith (chs (coerce fragment 'cons) + escaping nil) (iflet ch (car chs) (if escaping (do @@ -176,7 +177,7 @@ (case ch #\\ (self (cdr chs) t) (do (s ch) - (self (cdr chs) nil)))))) (coerce fragment 'cons) nil)))) + (self (cdr chs) nil)))))))) (def assemble-string (fragments) (if no.fragments src/arc/lib/parser.arc @@ -24,7 +24,7 @@ (itable (cadr tok))))) (def delete-from-index (itable remfn) - (ontable k v itable + (each (k v) itable (= itable.k (rem remfn v)))) (assign definers (cdr '(x def mac redef assign defop newsop defweld atdef))) src/arc/lib/source.arc @@ -1,5 +1,11 @@ (register-test '(suite "Foundation Tests" + + ("datetime breaks date into calendar components" + ((fn (d) + (list d.5 d.4 d.3)) (datetime 1203450000)) + (2008 01 19)) + (suite "Strings" ("get the length of a string" (len "foo-bar-toto") src/arc/lib/tests/foundation-test.arc @@ -49,11 +49,10 @@ (trunc (/ (- (ended) started) 1000.0)) 0)) (marks () (len marked)) - (surrounded (p) ((afn (ns) + (surrounded (p) (afnwith (ns (neighbours p)) (if (no ns) 0 (mf (car ns)) (+ 1 (self (cdr ns))) - (self (cdr ns)))) - (neighbours p))) + (self (cdr ns))))) (here () `(,cursor-x ,cursor-y)) (dimension () `(,(+ max-x 1) ,(+ max-y 1))) (clear? (p) (cleared p)) @@ -61,7 +60,7 @@ (won? () (is (+ (len cleared) (len mf)) (apply * (dimension)))) (lost? () (catch - (ontable p bomb mf + (each (p bomb) mf (when (and bomb (cleared p)) (throw t))) nil)) @@ -87,7 +86,7 @@ (redraw this))))))) (def redraw (mf) - (ontable k v mf!cells + (each (k v) mf!cells (v (if (mf!clear? k) (if (mf!bomb? k) 'exploded 'exposed) src/arc/rainbow/mines.arc @@ -1,4 +1,4 @@ -(require-lib "rainbow/img") +(require-lib "rainbow/img") (attribute script src opstring) (attribute script type opstring) @@ -87,13 +87,16 @@ (clickable span "zoom_out_button" "zoom out") (text-input zoom0) (clickable span "copy_zoom_button" "copy")) - (tag tr - (tag td (pr "frames")) - (tag td (text-input frames)) - (tag (td colspan 2) (pr "for animation")))) - (tag (input type "submit" value "plot this")) - (nbsp) - (tag (input type "submit" value "animate (x+iy) -> (x'+iy')" id "animate")))) + (row (nbsp) + (nbsp) + (nbsp) + (pr "frames") + (text-input frames)) + (row (nbsp) + (tag (input type "submit" value "plot this")) + (nbsp) + (nbsp) + (tag (input type "submit" value "animate" id "animate")))))) (def spiral-help () (pr "plot values of iterating <code>z <- z2 + c</code> where c is <code>x+iy</code>")) @@ -188,7 +191,7 @@ z 0+0i n 0 repeats 0) - (while (and (small z) (< n 100000) (< repeats 1000)) + (while (and (small z) (< n 20000) (< repeats 1000)) (++ n) (assign z (+ c (* z z))) (if (apply p!plot (complex-parts z)) (++ repeats) @@ -230,7 +233,10 @@ (zap [+ _ stepy] y)))) (def animation-info () - (tag (span id "animinfo") (nbsp))) + (tag (span id "animinfo") (nbsp)) + (br) + (tag (input id "fps" value "20")) + (pr "fps")) (defop animate req (spiral-params req @@ -252,6 +258,7 @@ ; http://localhost:8085/spiral?x=-0.092&x0=-0.0318807&y=0.649&y0=0.6418998&ox=-0.18278875&oy=0.6933475&nc=0.0001&zoom=1.966080000000001&zoom0=1&frames=20 ; http://localhost:8085/animate?x=0.0743&x0=-0.1257&y=0.6464&y0=0.8464&ox=0.0011&oy=-0.0023&nc=0.01&zoom=1.5&zoom0=0.5&frames=400 ; http://localhost:8085/animate?x=-0.1&x0=-0.31&y=0.6264&y0=0.6264&ox=-0.1014390625&oy=0.7252390625&nc=0.08&zoom=2.5&zoom0=2.5&frames=1000 +; http://localhost:8085/animate?x=-0.314&x0=-0.317&y=0.6264&y0=0.6264&ox=-0.3&oy=0.45&nc=0.08&zoom=1.3&zoom0=1.3&frames=2000 ;; old coordinates: ; http://localhost:8080/animate?x=-0.39&y=-0.47&x0=-0.55&y0=-0.63&ox=-0.94625&oy=-0.77609375&nc=0.0008&zoom=1.2&frames=600 src/arc/rainbow/spiral.arc @@ -11,10 +11,5 @@ ((fn (a-bobo) (a-bobo 3) ) (annotate 'bobo 23)) - 69)) - - ("datetbl breaks date into calendar components" - ((fn (d) - (list (d 'year) (d 'month) (d 'day))) (datetbl 1203450000)) - (2008 01 19)))) + 69)))) src/arc/rainbow/tests/anarki-compatibility-test.arc @@ -38,7 +38,7 @@ (assign delay* 0.5 score* 0 paused* nil) (assign universe (table) cell-updates* (table)) (new-shape) - (ontable k v universe-cells* + (each (k v) universe-cells* (repaint-cell k nil)) (update-score)) @@ -50,12 +50,12 @@ (def shape (colour cells) (= colours (cons colour colours)) - ((afn (info) + (afnwith (info cells) (if info (let (rotation row col) (car info) (= shape-rotations.colour rotation) (set (shape-info (shape-cell-key colour rotation row col))) - (self (cdr info))))) cells)) + (self (cdr info)))))) (shape 'red '((0 0 1) (0 1 1) (0 2 1) (0 3 1) (1 1 0) (1 1 1) (1 1 2) (1 1 3))) @@ -194,7 +194,7 @@ (set-cell colour (+ row falling!y) (+ col falling!x)))) (def update-updates (cells-to-update) - (ontable k v cells-to-update + (each (k v) cells-to-update (repaint-cell k (if (is v 'none) nil v)))) (def repaint-cell (k colour) src/arc/rainbow/tetris.arc @@ -1,6 +1,8 @@ body, td { font-family:Verdana, sans-serif; font-size:7pt; + color:white; + background:black; } .clickable { src/arc/static/spiral.css @@ -56,6 +56,14 @@ }; } + function getFPS() { + var fps = parseFloat($("fps").value); + if (isNaN(fps) || fps > 100) { + fps = 100; + } + return fps; + } + var vars = ["x", "y", "x0", "y0", "zoom", "zoom0", "ox", "oy"]; for (var i = 0; i < vars.length; i++) { @@ -138,6 +146,12 @@ var n = 0; function step() { + var fps = getFPS(); + if (fps <= 0) { + setInterval(step, 50); + return; + } + var loaded = 0; var img = $("anim_" + n); img.style.display = 'none'; @@ -166,13 +180,16 @@ img = $("anim_" + n); } - $("animinfo").innerHTML = "frame " + n + ", " + img.alt + " (loaded " + loaded + " of " + ld + ")"; + fps = getFPS(); + $("animinfo").innerHTML = "frame " + n + ", " + img.alt + " (loaded " + loaded + " of " + ld + ") " + fps + "fps"; if (img.complete) { img.style.display = ''; } + + setTimeout(step, 1000/fps); } - setInterval(step, 50); + step(); } }; src/arc/static/spiral.js @@ -23,18 +23,20 @@ public class SystemFunctions { public ArcObject invoke(Pair args) { return Rational.make(System.currentTimeMillis() / 1000); } - }, new Builtin("datetbl") { + }, new Builtin("datetime") { public ArcObject invoke(Pair args) { Calendar c = new GregorianCalendar(); - c.setTime(new Date(1000 * Rational.cast(args.car(), this).toInt())); - Hash hash = new Hash(); - hash.sref(Symbol.make("year"), Rational.make(c.get(Calendar.YEAR))); - hash.sref(Symbol.make("month"), Rational.make(c.get(Calendar.MONTH))); - hash.sref(Symbol.make("day"), Rational.make(c.get(Calendar.DAY_OF_MONTH))); - hash.sref(Symbol.make("hour"), Rational.make(c.get(Calendar.HOUR_OF_DAY))); - hash.sref(Symbol.make("minute"), Rational.make(c.get(Calendar.MINUTE))); - hash.sref(Symbol.make("second"), Rational.make(c.get(Calendar.SECOND))); - return hash; + if (!args.isNil()) { + c.setTime(new Date(1000 * Rational.cast(args.car(), this).toInt())); + } + return Pair.buildFrom( + Rational.make(c.get(Calendar.SECOND)), + Rational.make(c.get(Calendar.MINUTE)), + Rational.make(c.get(Calendar.HOUR_OF_DAY)), + Rational.make(c.get(Calendar.DAY_OF_MONTH)), + Rational.make(c.get(Calendar.MONTH)), + Rational.make(c.get(Calendar.YEAR)) + ); } }, new Builtin("current-process-milliseconds") { public ArcObject invoke(Pair args) { @@ -61,6 +63,10 @@ public class SystemFunctions { public ArcObject invoke(Pair args) { return Symbol.make(System.getProperty("os.name").replaceAll(" ", "").toLowerCase()); } + }, new Builtin("declare") { + public ArcObject invoke(Pair args) { + return NIL; + } }, new Builtin("quit") { public ArcObject invoke(Pair args) { System.exit(0); src/java/rainbow/functions/SystemFunctions.java ad9e3d0ec94749876408672536ffc6cabfd75acc conan conan@london.local http://github.com/conanite/rainbow/commit/727525530513bd793baf397de0a9acfdf729e14e 727525530513bd793baf397de0a9acfdf729e14e

2009-07-05T14:34:14-07:00

- afnwith in lib/bag-of-tricks - use each instead of ontable - delete datetbl (ex anarki), implement datetime (arc3) - implement null 'declare - does nothing & returns nil e1004b1472440f2a4bec8d31d88346868fa897a2 conan conan@london.local