added launch-many-worlds/proc; Closes 10559

collects/2htdp/private/launch-many-worlds.rkt

@@ -1,18 +1,25 @@
-#lang scheme
+#lang racket 
 
-(require mred/mred mzlib/etc)
+(require mred/mred mzlib/etc htdp/error)
 
 (provide
-  launch-many-worlds
-  ;; (launch-many-worlds e1 ... e2)
-  ;; run expressions e1 through e2 in parallel,
-  ;; produce all values
-  )
+ ;; (launch-many-worlds e1 ... e2)
+ ;; run expressions e1 through e2 in parallel,
+ ;; produce all values
+ launch-many-worlds
+ ;; launch-many-worlds/proc : (-> Any) *-> [Listof Any]
+ launch-many-worlds/proc)
 
 (define-syntax-rule 
   (launch-many-worlds e ...) 
   (launch-many-worlds* (lambda () e) ...))
 
+(define (launch-many-worlds/proc . loth)
+  ;; check args 
+  (for ([th loth][i (in-naturals 1)])
+    (check-proc 'launch-many-worlds/proc th 0 i "no arguments"))
+  (apply launch-many-worlds* loth))
+
 ;; [Listof (-> X)] ->* X ...
 (define (launch-many-worlds* . loth)
   (let* ([c* (make-custodian)]

collects/2htdp/tests/lauch-many-worlds-proc.rkt

@@ -0,0 +1,18 @@
+#lang racket
+
+;; ---------------------------------------------------------------------------------------------------
+;; testing launch many worlds/proc
+
+(require 2htdp/universe 2htdp/image)
+
+(define (aworld x c)
+  (big-bang 10
+            [to-draw (lambda (i) (text (number->string x) (+ 33 i) c))]
+            [on-tick sub1]
+            [stop-when zero?]))
+
+(define (main)
+  (apply launch-many-worlds/proc
+         (build-list 20 (lambda (x) (lambda () (aworld (+ 10 x) (make-color 255 255 x)))))))
+
+(main)

collects/2htdp/tests/xtest

@@ -18,6 +18,7 @@ run image-too-large.rkt
 run image-equality-performance-htdp.rkt
 run image-equality-performance.rkt
 run mouse-evt.rkt
+run lauch-many-worlds-proc.rkt
 run on-tick-defined.rkt
 run perform-robby.rkt
 run profile-robby.rkt

collects/2htdp/universe.rkt

@@ -22,7 +22,7 @@
          "private/universe.rkt"
          "private/universe-image.rkt"
          ;; 
-         (only-in "private/launch-many-worlds.rkt" launch-many-worlds)
+         (only-in "private/launch-many-worlds.rkt" launch-many-worlds launch-many-worlds/proc)
          (only-in "private/stop.rkt" make-stop-the-world)
          (only-in "private/check-aux.rkt" sexp?)
          htdp/error
@@ -33,9 +33,11 @@
 (provide stop-with) ;; World -> STOP
 
 (provide
- launch-many-worlds
  ;; (launch-many-worlds e1 ... e2)
  ;; run expressions e1 through e2 in parallel, produce all values in same order
+ launch-many-worlds
+ ;; launch-many-worlds/proc : (-> Any) *-> [Listof Any]
+ launch-many-worlds/proc
  )
 
 (provide-primitive

collects/htdp/error.rkt

@@ -40,19 +40,20 @@
 
 ;; check-proc : sym (... *->* ...) num (union sym str) (union sym str) -> void
 (define (check-proc name f exp-arity arg# arg-err)
+  (define arg#-text (if (number? arg#) (number->ord arg#) arg#))
   (unless (procedure? f)
-    (tp-error name "expected a function as ~a argument; given ~e" arg# f))
-  (let ([arity-of-f (procedure-arity f)])
-    (unless (procedure-arity-includes? f exp-arity)
-      (tp-error name "expected function of ~a as ~a argument; given function of ~a "
-                arg-err arg# 
-                (cond
-                  [(number? arity-of-f)
-                   (if (= arity-of-f 1)
-                       (format "1 argument")
-                       (format "~s arguments" arity-of-f))]
-                  [(arity-at-least? arity-of-f) "variable number of arguments"]
-                  [else (format "multiple arities (~s)" arity-of-f)])))))
+    (tp-error name "expected a function as ~a argument; given ~e" arg#-text f))
+  (define arity-of-f (procedure-arity f))
+  (unless (procedure-arity-includes? f exp-arity)
+    (tp-error name "expected function of ~a as ~a argument; given function of ~a "
+              arg-err arg#-text
+              (cond
+                [(number? arity-of-f)
+                 (if (= arity-of-f 1)
+                     (format "1 argument")
+                     (format "~s arguments" arity-of-f))]
+                [(arity-at-least? arity-of-f) "variable number of arguments"]
+                [else (format "multiple arities (~s)" arity-of-f)]))))
 
 ;; Symbol (_ -> Boolean) String X  X *-> X 
 (define (check-result pname pred? expected given . other-given)

collects/teachpack/2htdp/scribblings/universe.scrbl

@@ -1149,6 +1149,40 @@ Once you have designed a world program, add a function definition
  stopped, they produce the final states, here @racket[10], @racket[25], and
  @racket[33]. 
 
+For advanced programmers, the library also provides a programmatic
+interface for launching many worlds in parallel. 
+
+@defproc[(launch-many-worlds/proc [thunk-that-runs-a-world (-> any/c)] ...)
+          any]{
+ invokes all given @racket[thunk-that-runs-a-world] in parallel. Typically
+ each argument is a function of no argument that evaluates a @racket[big-bang]
+ expression. When all worlds have stopped, the function expression returns
+ all final worlds in order.}
+
+It is thus possible to decide at run time how many and which worlds to run
+in parallel:
+@;%
+@(begin
+#reader scribble/comment-reader
+(racketblock
+> (apply launch-many-worlds/proc 
+         (build-list (random 10)
+                     (lambda (i) (main (number->string i)))))
+0
+9
+1
+2
+3
+6
+5
+4
+8
+7
+))
+@;%
+
+
+
 @; -----------------------------------------------------------------------------
 @section[#:tag "universe-sample"]{A First Sample Universe}