in the middle of getting the rain program running

examples/counting-world-program.rkt

@@ -14,9 +14,8 @@ handler
 
 
 (big-bang 1
-          (on-tick add1 1)
+          (on-tick add1 1/28)
-          ;(on-tick (lambda (w) (* w 2)) 1)
+          (stop-when (lambda (w) (> w 500)))
-          (stop-when (lambda (w) (> w 10)))
           (to-draw draw)
           )
 

examples/rain-world-program.rkt

@@ -0,0 +1,101 @@
+#lang planet dyoo/whalesong
+
+(require (planet dyoo/whalesong/world))
+
+
+;; Rain falls down the screen.
+(define WIDTH 200)
+(define HEIGHT 500)
+
+(define GRAVITY-FACTOR 1)
+(define BACKGROUND (empty-scene WIDTH HEIGHT "solid" "black"))
+
+
+
+(define-struct posn (x y))
+
+
+;; A drop particle describes where it is on screen, what color it is, and
+;; how large it is.
+(define-struct drop (posn velocity color size)) 
+
+;; random-drop-particle: drop
+;; Generates a random particle.
+(define (random-drop)
+  (make-drop (make-posn (random WIDTH) 0)
+             (+ 5 (random 10)) ;; Get it falling
+             (random-choice (list "gray" "darkgray"
+                                  "white" "blue" 
+                                  "lightblue"
+                                  "darkblue"))
+             (random 10)))
+
+;; random-choice: (listof X) -> X
+;; Picks a random element of elts.
+(define (random-choice elts)
+  (list-ref elts (random (length elts))))
+
+
+
+;; The world consists of all of the drops in the sky.
+(define-struct world (sky ;; listof drop 
+                          ))
+
+;; tick: world -> world
+(define (tick w)
+  (make-world 
+   (filter not-on-floor?
+           (map drop-descend (cons (random-drop) (world-sky w))))))
+
+
+;; drop-descend: drop -> drop
+;; Makes the drops descend.
+(define (drop-descend a-drop)
+  (cond
+    [(> (posn-y (drop-posn a-drop)) HEIGHT)
+     a-drop]
+    [else
+     (make-drop (posn-descend (drop-posn a-drop) (drop-velocity a-drop))
+                (+ GRAVITY-FACTOR (drop-velocity a-drop))
+                (drop-color a-drop)
+                (drop-size a-drop))]))
+
+
+;; posn-descend: posn number -> posn
+(define (posn-descend a-posn n)
+  (make-posn (posn-x a-posn)
+             (+ n (posn-y a-posn))))
+
+
+;; on-floor?: drop -> boolean
+;; Produces true if the drop has fallen to the floor.
+(define (on-floor? a-drop)
+  (> (posn-y (drop-posn a-drop))
+     HEIGHT))
+
+(define (not-on-floor? a-drop) (not (on-floor? a-drop)))
+
+;; make-drop-image: color number -> drop
+;; Creates an image of the drop particle.
+(define (make-drop-image color size)
+  (circle size "solid" color))
+
+
+;; place-drop: drop scene -> scene
+(define (place-drop a-drop a-scene)
+  (place-image (make-drop-image (drop-color a-drop)
+                                (drop-size a-drop))
+               (posn-x (drop-posn a-drop))
+               (posn-y (drop-posn a-drop))
+               a-scene))
+
+
+;; draw: world -> scene
+(define (draw w)
+  (foldl place-drop BACKGROUND (world-sky w)))
+
+
+
+(big-bang (make-world '())
+          (to-draw draw)
+          (on-tick tick))

image/private/js-impl.js

@@ -547,6 +547,20 @@ EXPORTS['above/align'] =
 
 
 
+EXPORTS['empty-scene'] =
+    make-PrimitiveProcedure(
+        'empty-scene',
+	2,
+	function(MACHINE) {
+	    var width = checkNonNegativeReal(MACHINE, 'empty-scene', 0);
+	    var height = checkNonNegativeReal(MACHINE, 'empty-scene', 1);
+	    return makeSceneImage(jsnums.toFixnum(width), 
+                                  jsnums.toFixnum(height),
+                                  [],
+                                  true);
+	});
+
+
 
 EXPORTS['place-image'] = 
     makePrimitiveProcedure(

image/private/main.rkt

@@ -24,6 +24,7 @@
                     beside/align
                     above
                     above/align
+                    empty-scene
                     place-image
                     place-image/align
                     rotate

image/private/racket-impl.rkt

@@ -17,6 +17,7 @@
          beside/align
          above
          above/align
+         empty-scene
          place-image
          place-image/align
          rotate

js-assembler/runtime-src/runtime.js

@@ -1054,6 +1054,20 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
 	    return VOID;
         });
 
+
+    installPrimitiveProcedure(
+        'random',
+        plt.baselib.lists.makeList(0, 1),
+        function(MACHINE) {
+            if (MACHINE.argcount === 0) {
+                return plt.baselib.numbers.makeFloat(Math.random());
+            } else {
+                var n = checkNatural(MACHINE, 'random', 0);
+		return Math.floor(Math.random() * plt.baselib.numbers..toFixnum(n));
+            }
+        });
+
+
     installPrimitiveProcedure(
         'eq?',
         2,

lang/kernel.rkt

@@ -183,7 +183,7 @@
 ;;  current-inexact-milliseconds
 ;;  current-seconds
   void
-;;  random
+  random
 ;;  sleep
 ;;  (identity -identity)
 ;;  raise